COMMENT ⊗   VALID 00025 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE	FINDER	V.013	FOR STANFORD 6.00 AND BEYOND
C00011 00003		SUBTTL	DATA STORAGE FOR LOGIN
C00021 00004		SUBTTL	ALARUMS AND DIVERSIONS
C00023 00005		SUBTTL	VARIOUS FLAVORS OF OUTPUT STUFF
C00031 00006		SUBTTL	IF THE USER IS LOGGED IN ALREADY
C00034 00007		SUBTTL	FIND
C00036 00008		SUBTTL	THINK ABOUT PRIVILEGES
C00042 00009		SUBTTL	GET
C00044 00010		SUBTTL	LIST USER DATUM.
C00048 00011		SUBTTL	MODIFY A USER'S INFO ENTRY
C00052 00012		SUBTTL	READ UFD
C00053 00013		SUBTTL	DREAD	READ A WHOLE FILE IN DUMP MODE.
C00056 00014		SUBTTL	LOGIN: INITIALIZE AND DO THE LOGIN
C00065 00015		SUBTTL	CONTINUE. CHECK FOR SPECIALS
C00083 00016		SUBTTL	HERE IMEDIATELY AFTER LOGIN.
C00086 00017		SUBTTL	DO THE LOGIN NOW!
C00090 00018		SUBTTL	DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
C00098 00019		SUBTTL	DO ALL THE MESSAGE STUFF FROM [2,2]
C00110 00020		SUBTTL	BUFFERED READER AND OPTION FILE STUFF
C00122 00021		SUBTTL	UCHECK	CHECK VALIDITY BEFORE MAKING NEW UFD.
C00126 00022		SUBTTL	PREPARE SYSTEM STATISTICS.
C00129 00023		A FOOL AND HIS MONEY ARE SOON PARTED
C00132 00024	ALL HALLOWS EVE
C00136 00025	TEXT OF HELP MESSAGES
C00141 ENDMK
C⊗;
TITLE	FINDER	V.013	FOR STANFORD 6.00 AND BEYOND
	SUBTTL	R. GORIN 29-JAN-72
;	DEFINITIONS

IFDEF FOR,<MACRO←←0;>MACRO==1		;PROCESSOR SELECTOR


COMMENT $

*	QUIET RUNNING FOR PTY'S 
*	MESSAGES FROM [2,2]
*		NOTICE.TXT	GENERAL NOTICE
*		DAY.TXT		TODAY'S MESSAGE
*		MAINT.TXT	5 DAY MAINTAINENCE SCHEDULE
*		'PRJ'.MSX	PROJECT AREA MESSAGE
*		'PRG'.MSG	PERSONAL MESSAGE FOR PROGRAMMER
*	"SMART" MESSAGE ROUTINES
*	PRIVILEGE BITS, PASSWORDS AND DATE-TIME OF LAST LOGIN
*		FROM UFD'S RETRIEVAL DATA
*	READS USER'S FILE OPTION.TXT FOR LOGIN OPTIONS
*		LOGRUN		LOGRUN OPTION
*		INIT		RUN INIT IN USRS AREA IF IT EXISTS
*		WHO		START WHO LINE
*		MESSAGE		TYPE MESSAGES WITHOUT ASKING
*	SETS USER'S SERVICE LEVEL BY REQUEST OR TO HIS RESERVATION

$


IFE MACRO,<
	DEFINE DEF(A,B)<
	A←B>
	DEFINE SDEF(A,B)<
	A←←B>
>
IFG MACRO,<
	DEFINE DEF(A,B)<
	A=B>
	DEFINE SDEF(A,B)<
	A==B>
>

	EXTERN	JOBFF,JOBREL,JOBDDT

OPDEF	RESET	[CALLI]
OPDEF	LEYPOS	[702300B17]	;SET LINE EDITOR Y POSITION
OPDEF	SLEVEL	[CALLI	400044]
OPDEF	RLEVEL	[CALLI	400054]
OPDEF	SWAP	[CALLI	400004]
OPDEF	LOGIN	[CALLI	15]
OPDEF	EXIT	[CALLI	12]
OPDEF	SETPRV	[CALLI	400066]
OPDEF	SLEEP	[CALLI	31]
OPDEF	PJOB	[CALLI	30]
OPDEF	GETPPN	[CALLI	24]		;CAN'T BE USED WHEN JACCT SET!
OPDEF	JBTSTS	[CALLI	400013]
OPDEF	DATE	[CALLI	14]
OPDEF	TIMER	[CALLI	22]
OPDEF	CORE	[CALLI	11]
OPDEF	CTLV	[CALLI	400001]	;SUPRESS DUPLEXING (TOGGLES)
OPDEF	TTCALL	[51B8]
OPDEF	INCHRW	[TTCALL]
OPDEF	OUTCHR	[TTCALL	1,]
OPDEF	INCHRS	[TTCALL 2,]
OPDEF	OUTSTR	[TTCALL 3,]
OPDEF	INCHWL	[TTCALL 4,]
OPDEF	INCHSL	[TTCALL	5,]	;SKIP AND INPUT ONE IF LINE READY
OPDEF	GETLIN	[TTCALL 6,]
OPDEF	RESCAN	[TTCALL	10,]
OPDEF	CLRBFI	[TTCALL 11,]
OPDEF	INSKIP	[TTCALL	13,]
OPDEF	PTWR1W	[711340,,0]	;PTYUUO 7,
OPDEF	PTWR1S	[711300,,0]	;PTYUUO 6,
OPDEF	PEEK	[CALLI	33]
OPDEF	GETPRV	[CALLI	400115]

;ASSEMBLY FLAGS

SDEF(PTYBIT,4000)		;LINE CHAR. PTY LINE
SDEF(IMPBIT,1000)		;THIS AND PTYBIT MEANS THIS IS AN IMP
SDEF(JLOG,10000)	;JOB IS LOGGED IN. BIT IN JBTSTS
SDEF(PDLEN,20)		;SIZE OF PUSH-DOWN LIST
SDEF(UFDN,4)		;LENGTH OF UFD ENTRY
SDEF(MFDTRK,1)		;TRACK WHERE MFD IS FOUND
SDEF(INFON,5)		;LENGTH OF INFO DATA AREA
SDEF(INFBAS,13)		;LOCATION OF INFO DATA IN RETRIEVAL

SDEF(MAINTM,254)	;ADDRESS OF MAINTMODE IS FOUND AT ABS 254
SDEF(EXPMOD,262)
SDEF(NOLOGI,267)	;ADDRESS OF THE NO LOGIN CELL IN SYSTEM.
SDEF(PTYJOB,270)	;CELL TO PEEK IN TO FIND PTYJOB
SDEF(TTYNUM,221)	;CELL TO GET DATA ABOUT THE NUMBER OF TELETYPES.
SDEF(PRJPRG,211)	;POINTER TO PRJPRG IN SYSTEM

;	INDICIES TO INFON
	SDEF(LOSPSW,0)		;PASSWORD INDEX
	SDEF(PRVBIT,1)		;USER'S PRIV. BITS
	SDEF(LASDAT,2)		;LAST DATE WHEN HE WAS LOGGED IN
	SDEF(DEFPRO,3)		;DEFAULT PROTECTION

SDEF(DSK,17)		;READ/WRITE CHANNEL FOR DSK.
SDEF(DMP,16)		;DISK FOR DUMP MODE
SDEF(TTY,15)

SDEF(DPYBIT,400000)	;III BIT IN GETLIN
SDEF(CTYBIT,200000)	;CTY
SDEF(DDBIT,20000)	;DD BIT IN GETLIN

SDEF(ME,2)			;PERSONAL MESSAGE FROM LOGIN
SDEF(MESSAG,4)			;TYPE [2,2] MESSAGE AUTOMATICALLY
SDEF(RPGSW,10)			;WE ARE RESCANNING LOGIN LINE
;VACANCY
SDEF(CTLVF,40)			;FLAG TO REMEMBER CTLV MODE
SDEF(PTYLIN,200)		;SET IF PTY
SDEF(CTYLIN,400)		;SET IF CTY LOGIN
SDEF(DPYLIN,1000)		;SET IF EITHER III OR DD DISPLAY
;SDEF(GODBIT,2000)		;SET IF ε GOD TABLE IS COMING IN
SDEF(MAINT,4000)		;SET IF MAINTMODE IN SYSTEM ≠ 0
SDEF(NEGF,10000)		;SET TO FLUSH A PRIVILEGE
SDEF(NODATE,20000)		;SET TO PREVENT LASDAT UPDATE
SDEF(NOTNOW,40000)		;SET IF NOLOGIN IN SYSTEM ≠ 0
SDEF(IMPLIN,100000)		;SET IF THIS IS AN IMP
SDEF(FOOLS,200000)		;SET IF TODAY IS APRIL 1.
SDEF(DIGEST,400000)		;SET FOR NEWS DIGEST.
SDEF(PORNO,1)			;FL LEFT. SET TO RUN THE PORNO PROGRAM.
SDEF(NOMAIL,2)			;DON'T ASK ABOUT MESSAGES.
SDEF(%INIT,4)			;INIT OPTION
SDEF(LOGRUN,10)			;WE HAVE A PROGRAM TO RUN LATER.
SDEF(COOKEE,20)			;HIGHER BROW FORTUNE COOKIES

;PRIVILEGE BITS
SDEF(INFPRV,20)			;ACCESS TO INFO DATA IN UFD
SDEF(PROPRV,100000)		;RENAME THRU FILE SYSTEM IS OK
SDEF(REAPRV,40000)		;READ THRU FILE SYSTEM IS OK
SDEF(WRTPRV,20000)		;WRITE THRU FILE SYSTEM IS OK
SDEF(DAWPRV,200000)		;DISK ABSOLUTE WRITE PRIVILIGE
SDEF(LUPPRV,1)
SDEF(LOGPRV,DAWPRV!INFPRV!PROPRV!REAPRV!WRTPRV!LUPPRV)	;PRIVILEGES FOR LOGIN

	DEF(FL,0)		;THE ACCUMULATOR DEFINITIONS
	DEF(A,1)
	DEF(B,2)
	DEF(C,3)
	DEF(D,4)
	DEF(W,5)
	DEF(X,6)
	DEF(Y,7)
	DEF(Z,10)
	DEF(K,11)
	DEF(L,12)
	DEF(M,13)
	DEF(N,14)
	DEF(TAC,15)		;VERY TEMP. AC
	DEF(TAC1,16)		;ANOTHER VERY TEMP AC
	DEF(P,17)



SDEF(FORLEN,110)		;RADIX 8 LENGTH OF FORTUNE TABLE

NETGUE==0
IFN NETGUE,<
SDEF(NGNMWD,14)			;LENGTH OF BUFFER FOR NETGUE'S REAL NAME
SDEF(NGNMLN,5*NGNMWD-1)		;DITTO IN CHARACTERS
>

	LOC	137
	13			;JOBVERSION
	RELOC	0
	SUBTTL	DATA STORAGE FOR LOGIN

SPYNOW:	'SPYNOW'			;THIS AND =31 MORE WORDS IS MAILED
SPYNAM:	0				;PPN OF GUY WE'RE SPYING ON.
SPYTAB:	'   RLL'			;TABLE OF NETWORK USERS TO SPY ON.
	'  SREG'
SDEF(SPYLEN,.-SPYTAB)

LPBITS:	XWD	400000,'PRI'		;PRIVILEGE PRIVILEGE
	XWD	200000,'DAW'		;DISK ABSOLUTE WRITE
	XWD	100000,'PRO'		;FILE SYSTEM RENAME 
	XWD	 40000,'REA'		;FILE SYSTEM READ
	XWD	 20000,'WRT'		;FILE SYSTEM WRITE
	XWD	 10000,'UDP'		;UDP EXTENDED ACCESS
	XWD	  4000,'UPG'		;SELECT OTHER III'S
	XWD	  2000,'MES'		;TTYMES UUO
	XWD	  1000,'KIL'		;CONSOLE KILL COMMAND
	XWD	   400,'DEV'		;DET/ATT DEVICE
	XWD	   200,'SEG'		;SEGMENT ACCESS PRIV
	XWD	   100,'SSL'		;SET SYSTEM SERVICE LEVEL TABLE
	XWD	    40,'ACW'		;ABSOLUTE CORE WRITE (SETPR2)
	XWD	    20,'INF'		;DISK ABSOLUTE READ
	XWD	    10,'TLK'		;CAN DO TALKS
	XWD          4,'FBW'		;FAST BAND WRITE OR WRONG
	XWD	     2,'XGP'		;XGP FONT ACCESS.
	XWD	     1,'LUP'		;The Not Telnet Privilege
SDEF(LPBLL,.-LPBITS)

RPBITS:					;RIGHT SIDE BITS.
SDEF(RPBLL,.-RPBITS)
ALLPRV:	777775,,0			;THESE ARE THE LEGAL ONES FOR USERS
					;NOTE: XGPPRV ISN'T ALLOWED.

MSGPPN:	'  2  2'		;PLACE TO FIND MESSAGES


CRLF:	BYTE(7)15,12

TRNSWP:	SIXBIT /DSK/		;FOR INIT OPTION.
	SIXBIT /INIT/
	SIXBIT /DMP/
	0
TRNUSR:	0		;PUT PPN HERE

LRB:	'SYS   '
LRB1:	'LOGRUN'
	'DMP   '
	0
	0

PRB:	'SYS   '
PRB1:	'PRN   '
	'DMP   '
	0
	0

REMOTE:	10			;DIAL UP LINE NUMBERS
	11
	0			;0-5 ARE PINE HALL
	1
	2
	3
;	4	in prancing pony
	5
	16			;16 IS IMLAC IN POLYA LIBRARY
SDEF(REMTL,.-REMOTE)		;TABLE SIZE

PROTAB:	'  1  2'		;PROTECT FROM LOGIN.
SYSPPN:	'  1  3'
GOD:	'  1  1'
	'   DOC'
PROTLN==.-PROTAB

				;PROTECT FROM NETWORK LOGIN
NNETAB:	'ACTREG'		;I KNOW HOW TO GET AROUND IT
	'   SYS'		;ANYONE USING SYS OUGHT TO ALSO.
NNETLN==.-NNETAB


MSGL1:			;LIST OF MESSAGE FILES OF INTEREST TO LOGIN
	'X     '	;EXPERIMENTAL WARNING MESSAGE!
MSGPG1:	0		;PURGER MESSAGES.
MSGPRG:	0		;PROGRAMMER MESSAGE
MSGPRJ:	0		;PROJECT MESSAGE
PPNMES:	0		;PPN MESSAGE.
MSGPG2:	0		;AP NOTICE TO PERSON
	'NOTICE'	;LIST OF THE SYSTEM MESSAGE FILES OF INTEREST
EVENTX:	0		;TODAY'S DAYCNT IN OCTAL FOR EVENT FILE
EVENTY:	0		;TOMORROW'S DITTO
EVENTZ:	0		;MONDAY'S DITTO IF TODAY IS FRIDAY
	'DAY   '	;
	'MAINT '	;
	'FORTUN'	;COOKIE
	'DIGEST'	;AP NEWS DIGEST FILE
SDEF(MSGLTL,.-MSGL1)	;LENGTH OF MESSAGE TABLE
MSGPG3==137
MSGPG4==100+20+4
MSGL2:	XWD	'TXT',4	;CODE 4: SEND MESSAGE ONLY IF EXFLAG SET
	XWD	'PUR',5	;CODE 5: SEE BELOW
	XWD	'MSG',1	;CODE 1 = ASK HIM UNLESS MESSAG IS SET
	XWD	'MSG',2	;CODE 2 TYPE, EXCEPT IF /, TYPE ONLY NEW, ∂ HACK
	XWD	'MSG',1	;PPN MESSAGE.
	XWD	'NAP',6	;MESSAGE FROM AP SYSTEM.
	XWD	'TXT',2	;FILE EXTENSION,,DECISION CODE
	XWD	'DAY',10;TODAY EVENTS
	XWD	'DAY',10;TOMORROW EVENTS
	XWD	'DAY',10;MONDAY'S EVENTS IF TODAY IS FRIDAY
	XWD	'TXT',0	;CODE 0 = TYPE IF , OR / AND NEW
	XWD	'TXT',0	;
	XWD	'TXT',3	;
	XWD	0,7	;CODE 7 SEND MESSAGE ONLY IF NEW AND DIGEST REQUESTED.

MONTHT:	SIXBIT/JAN/
	SIXBIT/FEB/
	SIXBIT/MAR/
	SIXBIT/APR/
	SIXBIT/MAY/
	SIXBIT/JUN/
	SIXBIT/JUL/
	SIXBIT/AUG/
	SIXBIT/SEP/
	SIXBIT/OCT/
	SIXBIT/NOV/
	SIXBIT/DEC/
SDEF(MONTLG,.-MONTHT)		;LENGTH OF MONTH TABLE

GOODGY:	'REG'		;		GORIN
	'TED'		;		PANOFSKY
	'JOE'		;		ZINGHIEM
	'SYS'		;		SYSTEM SOURCE FILES
	'EHS'		;		STUART
	'ELM'		;		MCGUIRE
	'JBR'		;		RUBIN
	' BH'		;		HARVEY
	' ME'		;		FROSTY
	'SGK'		;		KUGELL
SDEF(GOODTL,.-GOODGY)	;LENGTH OF GOODGUY TABLE

SDEF(FILBLK,2)			;NUMBER OF BLOCKS OF THE FILE TO READ
				;WARNING!!! FILBLK MUST BE AT LEAST 2.
SDEF(FILENG,FILBLK*200)		;NUMBER OF WORDS TO READ

INRD:	'GODMOD'		;FOR MTAPE TO READ INFO AREA
	1			;READ
	IOWD	40,FILE0	;IOWD FOR TRANSFER
INRD1:	0			;XWD RECORD,TRACK NUMBER

RDINFO:	'GODMOD'		;READ RETRIEVAL INFO
	10
	INFOS

WRINFO:	'GODMOD'		;WRITE RETRIEVAL INFO
	11
	INFOS

DEBUG:	0
DSKBUF:	BLOCK	3		;BUFFER HEADER
TTYOBF:	BLOCK	3		;BUFFER HEADER FOR CHANNEL "TTY"
LZAP:				;FIRST LOC ZEROED AT START OF LOGIN
TTYBUF:	0			;ADDRESS OF BUFFERS FOR USER CONSOLE
DISKBF:	0			;PLACE TO PUT DISK BUFFERS
NOW:	0			;SET TO DATE,,TIME IN MINUTES WHEN STARTED
DBLOCK:	
USER:	0			;USERS PPN
USRBIT:	0			;USER PRIVILEGE BITS
SDEF(LBLEN,.-DBLOCK)
UFDLOK:	BLOCK	5		;4 WORDS FOR UFD RENAME BLOCK, 5TH FOR FLAG
PDLIST:	BLOCK	PDLEN		;PUSH DOWN LIST

GOTUFD:	0			;HAS USER ALREADY GOT A UFD?
INFOS:	BLOCK	INFON
PHRASE:	BLOCK	2		;PROJECT/WD 1, PROGRAMMER/WD 2.
MFDPT:	0
SFLAG:	0
LPTBUF:	0
SLREQ:	0			;USER REQUEST FOR SERVICE LEVEL
RSL:	0
CSL:	0

BUF:				;THIS IS A PUN. USED FOR READING LOG.LOG
FILE0:	BLOCK	40		;BLOCK FOR THE RETRIEVAL
FILE:	BLOCK 	FILENG		;BLOCK FOR FIRST BLOCK OF FILE
MUDPTR:	BLOCK	2
NOTEON:	0			;SET TO -1 WHILE PROCESSING NOTICE.TXT
DFAKE:	0			;SET TO -1 IF FAKING DISK BY ABS READS
COOKIE:	0			;COUNT NUMBER OF CHARACTERS BEFORE COOKIES
				;WHEN <0 MEANS YOU HAVE TO TURN ON THE OVEN
COOKON:	0			;SET IF MAKING COOKIE THING
CDONE:	0			;SET TO -1 WHEN COOKIES ARE COOLING
DAY:	0
MONTH:	0
YEAR:	0
TIME:	0
MESDAY:	0			;SAVE P-P DELIMITER 
FILLCH:	0
BASECH:	0
RAD:	TZAP:	0		;RADIX FOR ALLRAD PRINTER.
; TZAP IS LAST WORD ZEROED BY BLT AT START
LASLOG:	0
DAYTAB:	ASCIZ	/Sunday/
	ASCIZ	/Monday/
	ASCIZ	/Tuesday/
	ASCIZ	/Wednesday/
	ASCIZ	/Thursday/
	ASCIZ	/Friday/
	ASCIZ	/Saturday/
CKCODE:	-1			;SET TO ZERO IF LOSER IS NOT AUTHORIZED.

IFN NETGUE,<
NGNMUU:	'WHO',,0		;TMPCOR ARG FOR NETGUE'S REAL NAME
	IOWD	0,NGNMBF
NGNMBF:	BLOCK	NGNMWD		;NAME GOES HERE
>

PATCH:	BLOCK	20
PATCH1:	BLOCK	20
PATCH2:	BLOCK	20

JOBQUE:	0
JBTSTS:	0
JOBN:	0
SVSTAT:	0
LINCHR:	0			;TTY LINE CHARACTERISTICS WORD
PTYTJB:	0			;JOB NUMBER OF CONTROLLER IF THIS IS A PTY.
PTYPPN:	0			;PPN OF CONTROLLING JOB FOR PTY LINES.

CHTEMP:	0
TYIBUF:	BLOCK	50		;BUFFER FOR SPECIAL HACK MODE
	SUBTTL	ALARUMS AND DIVERSIONS
NODISK:	OUTSTR	NODSKM
	EXIT		
NOCORE:	OUTSTR	[ASCIZ/Core uuo failed!
/]
	EXIT		
UFDEER:	OUTSTR	[ASCIZ/Can't make your new ufd
/]
	EXIT		

UFDLER:	OUTSTR	[ASCIZ/UFD Lookup failed. /]
	CAIL	B,UERRTL
	MOVEI	B,0		;LOSER LOSER
	OUTSTR	@UERRTB(B)	;GIVE MESSAGE FROM TABLE
	OUTSTR	CRLF
	EXIT		
UERRTB:	[ASCIZ/UNKNOWN STATUS/]
	[ASCIZ/ILLEGAL PPN/]
	[ASCIZ/PROTECTION/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/NAMES CONFLICT/]
	[ASCIZ/NO INIT/]
	[ASCIZ/BAD MFD ENTRY/]
	[ASCIZ/UFD GARBAGED/]
SDEF(UERRTL,.-UERRTB)


NOUFD:	OUTSTR	[ASCIZ/I CAN'T FIND THE UFD THAT I JUST MADE FOR YOU!
/]
	EXIT
	SUBTTL	VARIOUS FLAVORS OF OUTPUT STUFF
;	OUTPUT ROUTINES. ALL ROUTINES USE PUTCHR TO TYPE
;	ONE CHARACTER ON CHANNEL TTY.  THIS CHANNEL IS INITIALLY
;	THE USER CONSOLE, BUT MAY BE SWITCHED TO THE LPT
;	FOR THE L COMMAND FROM [1,2] USER MODE.

LPTRLS:	SKIPN	A,LPTBUF	;ASSUME LPT BUFFER IS AT HIGH CORE
	POPJ	P,		;NO BUFFERS-NO RELEASE
	MOVEM	A,JOBFF		;RECLAIM THE SPACE
	CLOSE	TTY,		;FORCE OUT ALL THE DATA
	SETZM	LPTBUF		;ZERO THE BUFFER POINTER
TTYINI:	INIT	TTY,0		;GET THE TTY
	'TTY   '		;USER CONSOLE
	XWD	TTYOBF,0	;OUTPUT ONLY
	JRST	NOTTY		;THIS CAN'T HAPPEN
	SKIPN	A,TTYBUF	;DID WE HAVE BUFFERS ONCE BEFORE?
	JRST	TTYIN1		;NOPE. MAKE NEW ONES
	EXCH	A,JOBFF		;YES RESET JOBFF
	OUTBUF	TTY,2		;RESET THE OLD BUFFERS
	MOVEM	A,JOBFF		;RESTORE JOBFF
	POPJ	P,		;ALL DONE
TTYIN1:	MOVE	A,JOBFF		;GET JOBFF
	MOVEM	A,TTYBUF
	OUTBUF	TTY,2		;GET SOME BUFFERS
	POPJ	P,		;RETURN

LPTINI:	INIT	TTY,0		;GET THE LPT ON CHANNEL NAMED TTY
	'LPT   '
	XWD	TTYOBF,0
	JRST	LPTIN1		;NO LPT AVAILABLE
	MOVE	A,JOBFF		;GET THE PRESENT JOBFF
	MOVEM	A,LPTBUF	;SAVE AS ADDRESS OF THE LPT BUFFER
	OUTBUF	TTY,2		;GET SOME BUFFERS
	JRST	CPOPJ1		;SKIP RETURN
LPTIN1:	OUTSTR	[ASCIZ/LPT IS NOT AVAILABLE.
/]
	POPJ	P,		;RETURN

PUTCHR:	SKIPN	LPTBUF		;ONLY DO IT THE HARD WAY FOR LPT
	JRST	PUTCH2
	SOSG	TTYOBF+2	;DECREMENT CHARACTER COUNT
	OUTPUT	TTY,		;WRITE A BUFFER
	IDPB	A,TTYOBF+1	;DEPOSIT CHARACTER IN BUFFER
	POPJ	P,

PUTCH2:	TTCALL	1,A		;WRITE ONE CHARACTER
	POPJ	P,

PUTSTR:	HRLI	B,440700	;7 BIT BYTE POINTER IN B
PUTST1:	ILDB	A,B		;LOAD A BYTE
	JUMPE	A,CPOPJ		;RETURN IF NULL
	PUSHJ	P,PUTCHR	;WRITE CHARACTER
	JRST	PUTST1		;LOOP

DECOUT:	SKIPA	B,[12]		;THE BASE
OCTOUT:	MOVEI	B,10		;BASE FOR OCTAL
	MOVEM	B,RAD
	SETZ	TAC,
	MOVEI	B,"0"
	MOVEM	B,BASECH	;SAVE BASE CHARACTER
ALLRAD:	IDIV	A,RAD		;DIVIDE BY THE RADIX
	HRLM	B,(P)		;SAVE REMAINDER
	SUBI	TAC,1		;DECREMENT THE CHARACTER COUNT
	JUMPE	A,ALLRD1	;JUMP IF DEEP ENOUGH
	PUSHJ	P,ALLRAD	;NO. MAKE A RECURSIVE CALL
	JRST	ALLRD3		;BUBBLE UP FROM RECURSION
ALLRD1:	MOVE	A,FILLCH	;GET THE FILL CHARACTER
ALLRD2:	SOJL	TAC,ALLRD3	;ALL DONE WITH FILL?
	PUSHJ	P,PUTCHR	;NO. WRITE ONE CHARACTER
	JRST	ALLRD2		;LOOP
ALLRD3:	HLRZ	A,(P)
	ADD	A,BASECH	;ADD THE BASE CHARACTER
	JRST	PUTCHR		;WRITE A CHARACTER AND POPJ.

TWODIG:	MOVEI	B,12
	MOVEM	B,RAD
	MOVEI	TAC,2
	MOVEI	B,"0"
	MOVEM	B,FILLCH
	MOVEM	B,BASECH
	JRST	ALLRAD

SIXOUT:	MOVE	TAC1,A		;GET THE SIXBIT INTO TAC1
SIXOU1:	JUMPE	TAC1,CPOPJ	;RETURN IF ALL DONE
	SETZ	TAC,		;ZERO IN TAC
	LSHC	TAC,6		;MOVE CH. INTO TAC
	MOVEI	A," "(TAC)	;MAKE CHARACTER IN A
	PUSHJ	P,PUTCHR
	JRST	SIXOU1		;LOOP

TYFIL:	PUSHJ	P,SIXOUT	;TYPE FILE NAME FROM A
	HLLZ	B,B		;GET THE EXTENSION
	JUMPE	B,CPOPJ		;NO EXTENSION
	MOVEI	A,"."
	PUSHJ	P,PUTCHR
	MOVE	A,B
	JRST	SIXOUT		;WRITE MORE

TYPPN:	HRLZ	B,A		;GET THE PROG
	PUSH	P,B		;SAVE
	HLLZ	B,A		;GET THE PROJ
	MOVEI	A,"["
	PUSHJ	P,PUTCHR
	MOVE	A,B
	PUSHJ	P,SIXOUT
	MOVEI	A,","
	PUSHJ	P,PUTCHR
	POP	P,A
	PUSHJ	P,SIXOUT
	MOVEI	A,"]"
	JRST	PUTCHR
TDOUT:	JUMPE	A,TDOUTX		;JUMP IF NO ENTRY HERE
	HLRZ	B,A			;GET THE DATE
	HRRZ	A,A			;GET THE TIME
	PUSH	P,A			;SAVE TIME
	IDIVI	B,37			;GET THE DAY IN C
	MOVEI	A,1(C)			;SAVE DAY OF MONTH
	IDIVI	B,14			;GET MONTH IN C
	ADDI	B,100
	MOVEM	B,YEAR			;SAVE YEAR
	PUSHJ	P,DECOUT		;WRITE DECIMAL
	MOVEI	A,"-"			;WRITE -
	PUSHJ	P,PUTCHR
	MOVE	A,MONTHT(C)		;GET THE NAME OF MONTH
	PUSHJ	P,SIXOUT
	MOVEI	A,"-"
	PUSHJ	P,PUTCHR
	MOVE	A,YEAR
	PUSHJ	P,DECOUT
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	POP	P,A
	IDIVI	A,74			;HOURS IN A,MINUTES IN B
	PUSH	P,B
	PUSHJ	P,TWODIG
	POP	P,A
	JRST	TWODIG		;WRITE TWO MORE AND RETURN
TDOUTX:	MOVEI	A,11			;GET A TAB
	PUSHJ	P,PUTCHR		;WRITE ONE
	JRST	PUTCHR			;WRITE TWO
LOGON:	TRNE	FL,PTYLIN
	POPJ	P,		;NOTHING FOR PTY'S
	HLRZ	A,NOW		;GET THE CURRENT DATE
	IDIVI	A,37
	MOVEI	D,1(B)		;GET DAY OF MONTH IN D
	IDIVI	A,14		;YEAR IN A, MONTH IN B
	TRNN	A,3		;SKIP IF NOT LEAP YEAR
	CAIGE	B,2		;SKIP IF AFTER FEBRUARY ON LEAP YEAR
	SUBI	D,1		;NOT LEAP YEAR & PAST FEB. SUBTRACT 1
	ADDI	A,3		;JAN 1, 1964 WAS A WEDNESDAY
	ADD	D,A
	LSH	A,-2		;DIV BY 4 MAKE # OF LEAP YEARS SINCE JAN 64
	ADD	A,D		;BASE FOR THIS DAY AND YEAR
	MOVE	D,[033614625035];MONTH OFFSET WORD
	ROT	D,1(B)
	ROT	D,1(B)
	ROT	D,1(B)
	ANDI	D,7
	ADD	A,D
	IDIVI	A,7
	LSH	B,1		;DOUBLE THE INDEX VALUE
	OUTSTR	DAYTAB(B)
	OUTSTR	[ASCIZ/	/]	;TYPE A TAB
	MOVE	A,NOW
	PUSHJ	P,TDOUT		;TYPE IT
	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	CLOSE	TTY,		;FORCE IT OUT
	POPJ	P,		;RETURN

OCTIN0:	OUTSTR	[ASCIZ/ILLEGAL CHARACTER IN OCTAL SCAN.  PLEASE TRY AGAIN
/]
OCTIN:	SETZB	A,C		;CLEAR SUCCESS FLAG, ACCUMULATOR
OCTIN1:	INCHWL	B
	CAIN	B,15
	JRST	OCTIN1
	CAIN	B,12
	POPJ	P,		;C>0 IF ANYTHING SEEN
	JUMPL	C,OCTIN0	;ONLY CRLF ALLOWED AFTER ?
	JUMPG	C,OCTIN2	;? NOT ALLOWED AFTER DIGIT
	CAIN	B,"?"
	SOJA	C,OCTIN1	;C<0 FOR HELP REQUEST
OCTIN2:	CAIL	B,"0"
	CAILE	B,"7"
	JRST	OCTIN0		;ERROR
	LSH	A,3
	ADDI	A,-"0"(B)
	AOJA	C,OCTIN1	;LOOP
	SUBTTL	IF THE USER IS LOGGED IN ALREADY
USRMOD:	SETOB	A,SFLAG
	SETPRV	A,		;ASK ABOUT OUR PRIVILEGES
	TLNN	A,INFPRV	;HAVE WE GOT THE PRIVILEGE?
	TDZA	B,B		;NO.
	MOVEI	B,URCON		;YES.
	GETPPN	A,
	MOVEM	A,USER		;SIMULATE MESSAGES FOR CURRENT USER
	SETZM	MESDAY
	MOVEM	B,124		;SET REENTRY POINT
	JRST	URCON

UEXIT:	SETOM	GUGGLE
	MOVE	A,[GUGGLE,,GUGGLE+1]
	BLT	A,ZATCH
	EXIT			;NO PASSWORD:  CALL EXIT

URCON:	RELEAS	TTY,3		;SUPPRESS TTY IO CLOSE
	PUSHJ	P,PASINI	;INITIALIZE THE PASSWORDS
	OUTSTR	[ASCIZ/Master /]
	MOVE	W,ONEPAS	;GET THE SPECIAL PASSWORD
	PUSHJ	P,PASSGO	;SEEK A PASSWORD
	JRST	UEXIT
	SETZM	LPTBUF
	PUSHJ	P,TTYINI
UCON:	PUSHJ	P,RMFD		;READ THE MFD
UCMSG:	OUTSTR	[ASCIZ/
E	EXIT
M	MODIFY
F	FIND USERS
P	PRIVILEGE NAMES
/]
	SKIPE	JOBDDT
	OUTSTR	[ASCIZ/$	DDT
/]
UC:	OUTSTR	[ASCIZ/*/]
	INCHWL	A
	CLRBFI
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2
	TRZ	A,40
	MOVSI	B,-UCTL
	HLRZ	C,UCT(B)
	CAME	A,C
	AOBJN	B,.-2
	JUMPL	B,UC1
	OUTSTR	[ASCIZ/?
/]
	JRST	UC

UC1:	HRRZ	C,UCT(B)
	PUSHJ	P,(C)
	JRST	UC

UCT:	XWD	"E",UEXIT
	XWD	12,CPOPJ
	XWD	15,CPOPJ
	XWD	"F",FIND
	XWD	"M",MODIFY
	XWD	"$",DDTGO
	XWD	175,DDTGO
	XWD	"H",UCTYPE
	XWD	"P",PTYPE	;TYPE PRIVILEGE NAMES
	XWD	"T",ITYPE	;TYPE STUFF
	XWD	"L",ILIST	;LIST STUFF
SDEF(UCTL,.-UCT)


DDTGO:	SKIPN	JOBDDT
	JRST	NODDT
	OUTSTR	[ASCIZ/(DDT)
/]
	JRST	@JOBDDT

UCTYPE:	POP	P,(P)
	JRST	UCMSG

NODDT:	OUTSTR	[ASCIZ/NO DDT
/]
	POPJ	P,
	SUBTTL	FIND
FIND:	OUTSTR	[ASCIZ/USER = /]
	PUSHJ	P,SIXIN			;GET SOME SIXBIT
	HRRZM	B,PHRASE		;SAVE PART 1
	CAIN	A,","			;MUST SEE A COMMA
	JRST	FIND0			;COMMA
	CAIE	A,12			;NOT COMMA: NEED LF
	JRST	FNDERR			;I DON'T UNDERSTAND
	JRST	FIND0A			;OK, B WILL BE USER NAME
FIND0:	PUSHJ	P,SIXIN			;GET ANOTHER
	HRL	B,PHRASE		;GET THE OTHER PART
FIND0A:	MOVEM	B,USER
	CAIE	A,12
	JRST	FNDERR
	MOVE	D,MFDPT
	AOJGE	D,CPOPJ
	PUSH	P,LPTBUF
	SETOM	LPTBUF
FIND1:	SKIPN	A,USER			;LOAD THE MASK
	JRST	FIND2			;ZERO MASK: TYPE ANYTHING
	MOVE	B,0(D)			;MASK ∧ ¬ NAME
	TRNN	A,-1			;SKIP IF PROG NAMED
	TRZ	B,-1			;NO PROG NAMED. SET PROG TO 0
	TLNN	A,-1
	TLZ	B,-1
	CAMN	A,B
FIND2:	PUSHJ	P,TYPEX			;TYPE USER NAME
	ADD	D,[XWD UFDN,UFDN]
	JUMPL	D,FIND1
	CLOSE	TTY,			;FLUSH OUTPUT
	POP	P,LPTBUF		;RESTORE OLD BUFFER  POINTER
	POPJ	P,

FNDERR:	OUTSTR	[ASCIZ/INVALID ITEM
/]
	CLRBFI
	POPJ	P,
	SUBTTL	THINK ABOUT PRIVILEGES

PRVTYP:	PUSH	P,A		;SAVE THE PR BITS
	MOVEI	A,11		;WRITE A TAB
	PUSHJ	P,PUTCHR	;..
	HLLZ	L,0(P)		;GET THE PR BITS (LEFT)
	MOVSI	M,-LPBLL	;GET THE LENGTH OF THE TABLE
	JUMPE	M,PRVTP3	;JUMP IF NO LEFT SIDE BITS
PRVTP1:	TDNN	L,LPBITS(M)	;SEE IF A BIT IS SET
	JRST	PRVTP2		;NOPE
	HRLZ	A,LPBITS(M)	;GET THE PRIV NAME
	PUSHJ	P,SIXOUT	;TYPE SIXBIT
	MOVEI	A," "
	PUSHJ	P,PUTCHR	;WRITE A SPACE
PRVTP2:	AOBJN	M,PRVTP1	;LOOP
PRVTP3:	POP	P,L		;GET THE BITS BACK
	HRLZ	L,L		;GET THE RIGHT SIDE BITS IN THE LEFT
	MOVSI	M,-RPBLL
	JUMPE	M,CPOPJ
PRVTP4:	TDNN	L,RPBITS(M)
	JRST	PRVTP5
	HRLZ	A,RPBITS(M)
	PUSHJ	P,SIXOUT
	MOVEI	A," "
	PUSHJ	P,PUTCHR
PRVTP5:	AOBJN	M,PRVTP4
	POPJ	P,

PRVGET:	MOVEM	A,PHRASE+1	;SAVE OLD PRIV. SET
	MOVEM	A,PHRASE	;SAVE HERE TOO
	JUMPE	A,PRVGT0	;ASK FOR NEW PRIVS
	OUTSTR	[ASCIZ/ADDED/]
	JRST	.+2
PRVGT0:	OUTSTR	[ASCIZ/NEW/]
	OUTSTR	[ASCIZ/ PRIVILEGES:  /]
PRVGT1:	PUSHJ	P,SIXIN		;GET SOME SIXBIT NAME IN B
	MOVEM	A,MESDAY	;SAVE THE DELIMITER IN MESDAY
	MOVSI	M,-LPBLL
	JUMPE	M,PRVGT3	;NO FLAGS ON THIS SIDE?
	JUMPE	B,PRVGT7	;FLUSH NULL STRINGS
PRVGT2:	HRRZ	A,LPBITS(M)	;GET THE NAME OF A PRIVILEGE
	CAME	A,B		;COMPARE TO WHAT WE SAW
	AOBJN	M,PRVGT2
	JUMPGE	M,PRVGT3
	HLLZ	A,LPBITS(M)	;GET THE BITS
	JRST	PRVGT5		;SET NEW BITS
PRVGT3:	MOVSI	M,-RPBLL	
	JUMPE	M,PRVGT6	;THIS IS A LOSS
PRVGT4:	HRRZ	A,RPBITS(M)
	CAME	A,B
	AOBJN	M,PRVGT4
	JUMPGE	M,PRVGT6
	HLRZ	A,RPBITS(M)	;GET THE BIT TO SET
PRVGT5:	TRNN	FL,NEGF
	IORM	A,PHRASE+1
	TRNE	FL,NEGF
	ANDCAM	A,PHRASE+1	;SHUT OFF BITS
	JRST	PRVGT7		;LOOK FOR MORE
PRVGT6:	OUTSTR	[ASCIZ/UNKNOWN: /]
	HRLZ	A,B		;GET THE OFFENSIVE NAME
	PUSHJ	P,SIXOUT	;WRITE IT
	OUTSTR	CRLF
PRVGT7:	MOVE	A,MESDAY
	CAIE	A,12		;LF STOPS THE WORLD
	JRST	PRVGT1		;LOOK FOR MORE
	MOVE	A,PHRASE+1
	MOVEM	A,INFOS+PRVBIT	;SAVE IN INFOS
	POPJ	P,		;RETURN

SIXIN:	SETZ	B,		;ZERO AN AC
	TRZA	FL,NEGF		;ZERO FLAG FOR -
SIXIN0:	TRC	FL,NEGF		;SET FLAG
SIXIN1:	INCHWL	A		;GET A CHARACTER
	CAIN	A,15
	JRST	SIXIN1		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[JUMPE B,SIXIN1	;IGNORE LEADING BLANKS AND TAB
		POPJ	P,]	;ELSE RETURN
	CAIE	A,","
	CAIN	A,12
	POPJ	P,		;RETURN FOR LF OR COMMA 
	CAIN	A,"-"
	JUMPE	B,SIXIN0
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2
	TRZ	A,40
	CAIG	A,40
	POPJ	P,		;RETURN
	SUBI	A,40
	ANDI	A,77
	TLNE	B,770000	;ANY BITS LEFT IN B?
	JRST	SIXIN1		;NOPE FLUSH EXTRA CHARACTERS
	LSH	B,6
	IOR	B,A
	JRST	SIXIN1		;LOOP

PROTYP:	TDNN	A,[777400,,000000]	;IF ANY OF THESE ARE ON, TYPE SOMETHING
	POPJ	P,
	MOVEI	B,[ASCIZ/	Default protection = /]
	PUSH	P,A		;SAVE THE WORD
	PUSHJ	P,PUTSTR
	LDB	A,[POINT 9,(P),8]	;GET PROTECTION.
	PUSHJ	P,OCTTYP		;TYPE OCTAL
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	MOVE	A,(P)
	TLNN	A,400		;THIS IS INELEGANT, BUT I DON'T REALLY WANT TO
	JRST	PRORET		;THINK ABOUT IT TOO HARD
	MOVEI	B,[ASCIZ/
400	Remote Account/]
	PUSHJ	P,PUTSTR
PRORET:	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	POP	P,A
	POPJ	P,

PROGET:	OUTSTR	[ASCIZ/New default protection halfword: /]
	MOVEI	B,0
PROGT1:	INCHWL	A		;GET A CHARACTER
	CAIN	A,15
	JRST	PROGT1		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[JUMPE B,PROGT1	;IGNORE LEADING BLANKS AND TAB
		POPJ	P,]	;ELSE RETURN
	CAIL	A,"0"
	CAILE	A,"7"
	POPJ	P,
	LSH	B,3
	IORI	B,-"0"(A)
	JRST	PROGT1

PTYPE:	TTCALL	3,[ASCIZ/The available privileges are: 
/]
	SETO	A,
	PUSHJ	P,PRVTYP		;TYPE ALL BITS
PRONAM:	OUTSTR	[ASCIZ/
The fields in the default protection word (LH) are:
777000	default proection for new files
000400	Remote account
/]
	POPJ	P,

OCTTYP:	IDIVI	A,10
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,OCTTYP
	HLRZ	A,(P)
	ADDI	A,"0"
	JRST	PUTCHR
	SUBTTL	GET
	XLIST
;THE ABOVE SUBTITLE IS MISLEADING
COMMENT $
THE FOLLOWING DEFINITIONS HAVE BEEN XLISTED TO WHET YOUR CURIOUSITY:
MPASS:	THE MAINTENANCE TIME PASSWORD
CPASS:	THE CTY PASSWORD
$
SDEF(GUGGLE,.)
	XLIST
MPASS:	'FEEPER'			;MAINTENCE TIME PASSWORD FOR ALIASES
CPASS:	'FEEPER'			;CTY PASSWORD FOR ALIASES
NODSKM:	ASCIZ	/CAN'T INIT THE DISK
/
ONEPAS:	0				;REMEMBER PASSWORD OF 1,1 HERE.
SDEF(ZATCH,.-1)	;ZERO FROM YOUR GUGGLE TO YOUR ZATCH BEFORE LOGIN UUO
	LIST
	SUBTTL	LIST USER DATUM.
ILIST:	PUSHJ	P,LPTINI	;GET THE LPT.
	POPJ	P,		;NOT THERE
	GETPPN	A,
	PUSHJ	P,TYPPN
	MOVEI	B,[ASCIZ/ requested this listing

/]
	PUSHJ	P,PUTSTR


ITYPE:	MOVE	D,MFDPT
	AOJGE	D,LPTRLS
ILIST1:	PUSHJ	P,TYPEX			;CALL TYPE OUT ROUTINES
	ADD	D,[XWD UFDN,UFDN]
	JUMPL	D,ILIST1
	JRST	LPTRLS			;RELEASE THE LPT IF IN USE


TYPEX:	SKIPE	B,0(D)			;IS THERE A PPN HERE?
	CAMN	B,['  1  1']
	POPJ	P,			;NO. RETURN
	HLRZ	B,1(D)			;MAKE SURE OF VAILD UFD
	CAIE	B,'UFD'
	POPJ	P,			;NOT VALID
	HRRZ	B,3(D)			;GET THE DISK ADDRESS
	MOVEM	B,INRD1			;SAVE
	PUSHJ	P,DOINRD		;READ THE DISK
	JRST	ILIST5			;ERROR
	MOVE	B,[XWD FILE0+INFBAS,INFOS]
	BLT	B,INFOS+4		;BLT SPECIAL RETRIEVAL DATA
	SKIPN	INFOS+LOSPSW		;SKIP IF HE'S GOT PASSWORD
	SKIPE	LPTBUF			;NO PASSWORD. SKIP IF TTY
	JRST	ILIST4			;PASSWORD OR LPT. WRITE IT
	SKIPN	INFOS+PRVBIT		;SKIP IF HE HAS PRIV BITS
	POPJ	P,			;TTY AND NO PASSWORD. SKIP THIS
ILIST4:	MOVE	A,0(D)	
	PUSHJ	P,TYPPN			;WRITE NAME
	MOVEI	A,11
	PUSHJ	P,PUTCHR		;AND TAB
	SKIPN	A,INFOS+LOSPSW		;GET THE PASSWORD
	JRST	ILST4X			;  IF ANY
	PUSHJ	P,SIXOUT		;WRITE
	MOVEI	A,"%"
	SKIPGE	2(D)			;IF REMOTE-ONLY PASSWORD,
	PUSHJ	P,PUTCHR		;  FLAG IT
ILST4X:	SKIPN	LPTBUF			;SKIP IF WE'RE ON THE LPT
	JRST	ILST4A			;ON THE TTY. SHORT MESSAGE
	MOVEI	A,11
	PUSHJ	P,PUTCHR		;WRITE A TAB
	MOVE	A,INFOS+LASDAT		;GET DATE AND TIME
	TLZ	A,400000		;DELETE BIT
	PUSHJ	P,TDOUT			;WRITE TIME AND DATE
	MOVEI	A,"*"
	SKIPGE	INFOS+LASDAT
	PUSHJ	P,PUTCHR		;FLAG ILLEGAL USERS.
ILST4A:	SKIPE	A,INFOS+PRVBIT		;GET THE USER PRV BITS
	PUSHJ	P,PRVTYP		;TYPE PR BITS
	MOVE	A,INFOS+PRVBIT
	ANDCM	A,ALLPRV
	JUMPE	A,ILST4B		;JUMP IF NO MYSTERY PRIVS.
	PUSH	P,A
	MOVEI	B,[ASCIZ/UNKNOWN PRIVILEGES =  /]
	PUSHJ	P,PUTSTR
	POP	P,A
	PUSHJ	P,OCTOUT
ILST4B:	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR		
	MOVE	A,INFOS+DEFPRO
	JRST	PROTYP			;TYPE PROTECTION DATA AND RETURN

ILIST5:	MOVEI	B,[ASCIZ/DISK ERROR READING UFD
/]
	JRST	PUTSTR			;WRITE STRING AND POPJ

	SUBTTL	MODIFY A USER'S INFO ENTRY
MODIFY:	OUTSTR	[ASCIZ/USER = /]
	PUSHJ	P,GETP
	POPJ	P,
	SKIPE	A,PHRASE+1
	SKIPN	PHRASE
	JRST	FNDERR		;MAKE ERROR MESSAGE
	HRL	A,PHRASE
	MOVE	D,MFDPT		;GET POINTER TO MFD
	AOJL	D,MODIF1	;MAKE DIRECT POINTER
	OUTSTR	[ASCIZ/MFD IS EMPTY?
/]
	POPJ	P,
MODIF1:	CAMN	A,(D)		;LOOK
	JRST	MODIF3		;FOUND ONE?
MODIF2:	ADD	D,[XWD UFDN,UFDN]	;FORGE ON
	JUMPL	D,MODIF1		;LOOP
	OUTSTR	[ASCIZ/NO SUCH UFD.
/]
	POPJ	P,
MODIF3:	HLRZ	B,1(D)
	CAIE	B,'UFD'
	JRST	MODIF2		;THIS IS NOT A UFD
	CAMN	A,['  1  1']
	POPJ	P,
	PUSH	P,D		;SAVE POINTER TO UFD
	HRRZ	B,3(D)		;GET THE TRACK ADDRESS
	MOVEM	B,INRD1		;SAVE
	PUSHJ	P,DOINRD	;READ RETRIEVAL
	JRST	ILIST5		;ERROR
	MOVE	A,[XWD FILE0+INFBAS,INFOS]
	BLT	A,INFOS+INFON-1	;GET THE DATA TO A CONVENIENT PLACE
	PUSHJ	P,MTYPE		;TYPE DATA FOR THIS GUY.
	OUTSTR	[ASCIZ/NEW PASSWORD = /]
	PUSHJ	P,GETP		;GET A PASSWORD
	SETZM	PHRASE		;NULL PASSWORD
	MOVE	A,PHRASE	;GET IT
	MOVEM	A,INFOS+LOSPSW	;SAVE IT
	MOVE	A,INFOS+PRVBIT	;GET PRIVILEGES
	PUSHJ	P,PRVGET	;GET A NEW SET OF PRIVILEGES
	PUSHJ	P,PROGET	;GET NEW PROTECTION BITS
	MOVSM	B,INFOS+DEFPRO	;SAVE NEW PROTECTION BITS IN LH
	MOVE	D,(P)
	OUTSTR	[ASCIZ/
DATA FOR THIS USER IS NOW:
/]
	PUSHJ	P,MTYPE
	POP	P,D		;GET D BACK AGAIN
	OUTSTR	[ASCIZ/WRITE THIS NOW? /]
	PUSHJ	P,YORN
	POPJ	P,		;NO
	MOVE	K,(D)		;GET USER NAME
	MOVSI	L,'UFD'
	SETZ	M,
	MOVE	N,GOD
	LOOKUP	DMP,K
	JRST	MODIF4		;CAN'T ENTER
;	SETZM	INFOS+LASDAT+1
;	MOVE	K,[XWD INFOS+LASDAT+1,INFOS+LASDAT+2]
;	BLT	K,INFOS+INFON-1
	MTAPE	DMP,WRINFO	;WRITE DATA INTO FILE
	JRST	MODIF5		;ERROR
	CLOSE	DMP,		;RELEASE FILE
	POPJ	P,

MODIF4:	OUTSTR	[ASCIZ/
UFD LOOKUP FAILED
/]
	POPJ	P,
MODIF5:	CLOSE	DMP,
	OUTSTR	[ASCIZ/INFO WRITE FAILED
/]
	POPJ	P,

MTYPE:	MOVE	A,(D)		;GET THE PPN
	PUSHJ	P,TYPPN
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	SKIPN	A,INFOS+LOSPSW
	JRST	MTYPE1
	PUSHJ	P,SIXOUT
	MOVEI	A,"%"
	SKIPGE	2(D)
	PUSHJ	P,PUTCHR
MTYPE1:	SKIPE	A,INFOS+PRVBIT
	PUSHJ	P,PRVTYP
	MOVEI	B,CRLF
	JRST	PUTSTR
	MOVE	A,INFOS+DEFPRO
	PUSHJ	P,PROTYP	;TYPE PROTECTION PART
	MOVEI	B,CRLF
	JRST	PUTSTR

DOINRD:	MTAPE	DMP,INRD	;READ RETRIEVAL
	POPJ	P,		;ERROR
	AOS	(P)
	MOVEM	A,1(P)
	HRRZ	A,(D)		;GET USER NAME
;	CAIE	A,'REG'		;SPECIAL?
	JRST	DOINR0		;YES.
DOINR1:	SKIPE	A,FILE0+LOSPSW+INFBAS
	MOVE	A,['QRALPH']
	MOVEM	A,FILE0+LOSPSW+INFBAS
DOINR0:	MOVE	A,1(P)		;GET DATA BACK
	POPJ	P,
	SUBTTL	READ UFD
RMFD:	MOVE	A,GOD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	MOVEI	W,UFDN
	ADDM	W,JOBFF		;INCREMENT JOBFF TO LEAVE SOME ROOM
	PUSHJ	P,DREAD
	EXIT			;THIS BETTER NOT HAPPEN. EVER
	SUB	W,[XWD UFDN,UFDN]
	MOVEM	W,MFDPT		;SAVE POINTER TO MFD 
	MOVE	A,GOD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVEI	D,MFDTRK	;1 IS THE TRACK ADDRESS OF MFD
	MOVEI	X,1(W)
	HRLI	X,A		;SOURCE,,DESTINATION IN X
	BLT	X,4(W)		;SAVE THE STUFF
	POPJ	P,		;RETURN
	SUBTTL	DREAD	READ A WHOLE FILE IN DUMP MODE.
;	SET A,B,C,D TO A LOOKUP BLOCK.
;	SKIP RETURN IF OK. W IS IOWD FOR DATA. FILE READ INTO JOBFF
;	NON SKIP: MESSAGE WILL BE TYPED
DREAD:	SETZB	W,X		;ZERO THINGS TO START RIGHT
	LOOKUP	DMP,A		;LOOK FOR THE FILE
	JRST	DREAD1		;FILE NOT FOUND. CODE IN B
	HRR	D,JOBFF		;GET JOBFF
	SUBI	D,1		;MAKE THIS AN IOWD
	MOVE	W,D		;SAVE THE IOWD
	HLRE	C,D		;GET - LENGTH OF FILE 
	MOVN	B,C	 	;GET + FILE LENGTH
	ADDB	B,JOBFF		;RESET JOBFF
	CAMG	B,JOBREL	;IS IT TOO BIG?
	JRST	.+3		;NO. WE'RE OK
	CORE	B,		;MAKE ENOUGH CORE HAPPEN
	JRST	NOCORE		;THIS IS A LOSS
	INPUT	DMP,W		;USE THE IOWD IN W TO READ THE WHOLE
	STATZ	DMP,740000	;CHECK TRANSFER STATUS
	JRST	DREAD2		;LOSING STATUS
	CLOSE	DMP,		;RELEASE THE FILE
	JRST	CPOPJ1		;GIVE THE OK RETURN
DREAD1:	CAME	A,['ALFACT']	;NO MESSAGE IF ACCOUNTING LOSES.
	TRNE	FL,PTYLIN
	JRST	DREAD4
	OUTSTR	[ASCIZ/LOOKUP FAILURE. FILE = /]
	PUSH	P,A
	PUSH	P,B		;SAVE FILE AND CODE
	PUSHJ	P,TYFIL		;WRITE FILE NAME
	OUTSTR	[ASCIZ/; CODE = /]
	HRRZ	A,(P)		;GET FROM STACK
	JRST	DREAD3
DREAD2:	TRNE	FL,PTYLIN
	JRST	DREAD4
	OUTSTR	[ASCIZ/I-O ERROR. FILE = /]
	PUSH	P,A
	PUSH	P,B
	PUSHJ	P,TYFIL
	OUTSTR	[ASCIZ/; STATUS = /]
	GETSTS	DMP,A
DREAD3:	PUSHJ	P,OCTOUT
	OUTSTR	CRLF
	POP	P,B
	POP	P,A
DREAD4:	CLOSE	DMP,
	POPJ	P,
	SUBTTL	LOGIN: INITIALIZE AND DO THE LOGIN
BEGIN:	TDZA	FL,FL
	MOVEI	FL,1		;SIGNIFY SPECIAL START UP.
	MOVEM	FL,TYIBUF	;STORE SPECIAL HACK FLAG
	RESET			;A GOOD WAY TO START THE DAY
	MOVE	P,[IOWD PDLEN,PDLIST]	;INITIALIZE PDL
	SETZB	FL,LZAP		;ZERO THE FIRST OF THE BLT AREA
	MOVE	A,[XWD LZAP,LZAP+1]
	BLT	A,TZAP		;ZERO TO TZAP


	SETOM	CKCODE		;ASSUME LEGITIMATE USER.
	INIT	DMP,217		;GET A DISK CHANNEL FOR USE LATER
	'DSK   '
	0
	JRST	NODISK		;THIS IS TERRIBLE
	PUSHJ	P,TTYINI	;GET A TTY

	DATE	A,		;GET CURRENT DATE
	TIMER	B,		;AND TIME IN TICKS SINCE MIDNITE
	IDIVI	B,74*74		;DIVIDE TICKS TO MAKE MINUTES
	HRL	B,A		;MAKE DATE,,TIME
	MOVEM	B,NOW		;SAVE TIME
	IDIVI	A,14*37		;YEARS IN A, DAY OF YEAR IN B
	CAIN	B,3*37		;IS THIS APRIL 1?
	TRO	FL,FOOLS	;YES. HAVOC!
	SETO	A,		;SET A TO GET LINE CHARACTERISTICS
	TTCALL	6,A		;GET LINE CHARACTERISTICS
	MOVEM	A,LINCHR	;LINE CHARACTERISTICS WORD
	TLNE	A,DPYBIT+DDBIT	;EITHER DATA DISK OR III?
	TRO	FL,DPYLIN	;YES FLAG IT
	TLNE	A,CTYBIT	;CTY?
	TRO	FL,CTYLIN	;YES
	TLNE	A,PTYBIT
	TROA	FL,PTYLIN	;FLAG A PTY
	JRST	BEGNPT		;THIS IS NOT A PTY.
	TLNE	A,IMPBIT		;IS THIS AN IMP?
	TRC	FL,IMPLIN+PTYLIN	;YES. SET IMP AND NOT PTY.
	MOVEI	A,TTYNUM	;PEEK INTO SYSTEM
	PEEK	A,
	LDB	B,[POINT 9,A,8]	;
	LDB	C,[POINT 9,A,17];
	ADDI	B,1(C)
	LDB	C,[POINT 9,A,26]
	ADDI	B,(C)
	HRRZ	A,LINCHR
	SUBI	A,(B)
	SETZM	PTYPPN		;CLEAR PPN OF OWNER
	SETZM	PTYTJB
	JUMPL	A,BEGNPT	;THIS CAN'T HAPPEN?
	MOVEI	B,PTYJOB
	PEEK	B,
	ADDI	B,(A)
	PEEK	B,
	MOVEM	B,PTYTJB	;JOB NUMBER OF CONTROLLING JOB.
	TLNE	FL,IMPLIN	;IS THIS AN IMP ALREADY?
	JRST	BEGNPT		;YES.  (PTYTJB IS SETUP)
	GETPRV	B,		;USER'S PRIVILEGES
	TLNN	B,1		;LOCAL USER?
	TRC	FL,IMPLIN!PTYLIN		;NO TURN ON IMPLIN
	MOVEI	A,PRJPRG
	PEEK	A,
	ADD	A,PTYTJB
	PEEK	A,
	MOVEM	A,PTYPPN	;PPN OF PTY OWNER.
BEGNPT:
IFG REMTL,<			;COMPILE IF WE HAVE REMOTE LINE KLUGE
	HRRZ	A,LINCHR	;GET LINE NUMBER ONLY
	MOVSI	B,-REMTL	;LENGTH OF TABLE
	CAMN	A,REMOTE(B)	;IS THIS REMOTE?
	TROA	FL,IMPLIN	;YES TURN ON THE BIT AND SKIP
	AOBJN	B,.-2		;NOT THIS ONE. LOOP.
>
	MOVEI	A,MAINTM	;GET THE ABS ADDRESS OF VECTOR
	PEEK	A,		;GET ABS ADDRESS OF CELL IN A
	PEEK	A,		;GET CONTENTS OF MAINTMODE IN A
	JUMPE	A,.+2		;JUMP IF NO MAINTAINENCE
	TRO	FL,MAINT	;SIGNAL MAINTMODE
	MOVEI	A,NOLOGI
	PEEK	A,
	PEEK	A,
	JUMPE	A,.+2
	TRO	FL,NOTNOW	;SET FLAG FOR NO LOGINS NOW.
	SKIPE	DEBUG		;SKIP UNLESS DEBUGGING
	JRST	LOG.1		;JUMP IF DEBUGGING
	PJOB	A,		;GET JOB NUMBER
	JBTSTS	A,		;GET JOB STATUS BITS
	TLNE	A,JLOG		;IS THIS JOB ACCOUNTING?
	JRST	USRMOD		;NO. RUN THE USER MODE PORTION
LOG.1:	MOVSI	A,LOGPRV	;LET US HAVE PRIVILEGES
	SETPRV	A,		;ASK SYSTEM TO LET US HAVE THEM
	PUSHJ	P,PASINI	;INITIALIZE PASSWORDS
	MOVNI	A,1
	TTCALL	6,A
	TLO	A,10
	TTCALL	7,A		;ASSUME NO HARDWARE TABS
	SKIPE	TYIBUF		;SKIP IF WE'RE IN SPECIAL HACK MODE.
	JRST	HACKR		;HACK READING ROUTINE
	RESCAN	D		;RESCAN THE LINE HE TYPED.
LOG.1A:	SOJL	D,LOGIN1	;GOT ANY CHARACTERS LEFT?
	INCHRS	A		;GET A CHARACTER
	MOVEI	A,175
	CAIE	A,"L"
	CAIN	A,"l"
	JRST	LOG.2		;HERE L IS SEEN
	CAIE	A," "
	CAIN	A,11
	JRST	LOG.1A		;IGNORE LEADING SPACE, TABS, FLUSH UNTIL "L"
	JRST	LOG.3		;SOMETHING NOT AN L IS SEEN.

LOG.2:	SOJL	D,LOGIN1
	INCHRW	A
	CAIE	A,11
	CAIN	A," "
	JRST	LOG.4
	JRST	LOG.2

LOG.3:	CAIN	A,175		;FLUSH ENTIRE RESCAN DATA
	EXIT			;CALL EXIT
	SOJL	D,LOGIN1	;ALL FLUSHED
	INCHRS	A		;GET ANOTHER
	MOVEI	A,175		;SHOULDN'T HAPPEN (INVENT A REASON TO EXIT)
	JRST	LOG.3		;FLUSH

LOG.4:	TRO	FL,RPGSW	;WE HAVE A LINE TO RESCAN
LOGIN1:	MOVE	P,[IOWD	PDLEN,PDLIST]	;MAKE SURE STACK IS HAPPY
	TRZ	FL,NODATE	;MIGHT BE LEFT OVER FROM BAD.PPN
	SETZM	GOTUFD		;WE DO NOT YET KNOW IF HE HAS A UFD.
	SETZM	SLREQ		;NO SL ARGUMENT SEEN YET
	TRNN	FL,RPGSW	;DON'T DO SHARP IF RPG IS SET
	OUTSTR	[ASCIZ/#/]	;ACT READY TO GET PRJ-PRG.
	PUSHJ 	P,GETP		;SCAN THE CRUFT THAT HE TYPES
	JRST	BADPPN		;THIS IS A LOSER
	TRZ	FL,RPGSW	;NO MORE RPG
	SKIPE	PHRASE
	SKIPN	PHRASE+1	;DID WE GET NULL PRJ OR PRG??
	JRST	BADPPN		;ILLEGAL
	HLLZ	D,PHRASE	;GET PHRASE OVERFLOW
	HLR	D,PHRASE+1	;MORE OVERFLOW
	JUMPN	D,BADPPN	;LOSE IF ANY OVERFLOW
	MOVEM	K,MESDAY	;SAVE THE PRJ-PRG DELIMITER
	HRLZ	D,PHRASE	;GET PROJECT
	HRR	D,PHRASE+1	;ADD IN PROGRAMMER
	MOVEM	D,USER		;SAVE IT ALL HERE.
	JRST	LOGIN2		;DO MORE.

BADPPN:	TRZN	FL,RPGSW	;CLEAR RESCANNING.
	JRST	BADPP0
	CAIN	A,12
	SKIPE	PHRASE		;SKIP IF THERE SIMPLY WAS NOTHING THERE
BADPP0:	OUTSTR	[ASCIZ/? Illegal Project-Programmer Name. Please try again.
/]
BADPP1:	INCHRS	A		;TOUGH SHIT IF HE TYPED AHEAD
	JRST	LOGIN1
	CAIN	A,175
	EXIT
	CAIN	A,12
	JRST	LOGIN1
	JRST	BADPP1

PASINI:	SKIPE	ONEPAS		;HAVE WE BEEN HERE BEFORE?
	POPJ	P,		;YES.
	MOVE	A,GOD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	LOOKUP	DMP,A
	JRST	UFDLER		;OOPS
	MTAPE	DMP,RDINFO	;READ 1,1 PASSWORD
	JRST	UEXIT		;SUPER HORRENDOUS ERROR NUMBER 0
	MOVE	A,INFOS+LOSPSW
	MOVEM	A,ONEPAS
	SETZM	INFOS+LOSPSW
	POPJ	P,

HACKR:	RESCAN	D
	MOVE	B,[POINT 9,TYIBUF]
	SETZM	TYIBUF
	CAIL	D,4*50-1		;WILL IT FIT?
	JRST	[OUTSTR	[ASCIZ/Please LOGIN first.  Type your Project-Programmer name.
/]
		JRST	BADPP1]		;NO. FLUSH UNTIL NOTHING LEFT
	MOVE	C,LINCHR		;NEED THIS TO TEST FOR FREE LF
HACKR0:	SOJL	D,HACKR1
	INCHRS	A
	EXIT				;LYING GODDAM SYSTEM
	JUMPE	A,HACKR0
	TLNE	C,2			;DO WE GET FREE LF?
	JRST	HACKR3			;NO, TREAT CR LIKE REGULAR OLD CHAR
	CAIN	A,15			;CR?
	JRST	HACKR2			;YES.
HACKR3:	IDPB	A,B
	JRST	HACKR0

HACKR2:	SOJL	D,HACKR3		;COUNT DOWN
	INCHRS	A			;GET THE LF
	EXIT
	XORI	A,7			;AS WE SAY IN FAIL, 12≠15
	JRST	HACKR3			;COPY CTRL-META FROM LF TO CR.

HACKR1:	MOVEI	A,0
	IDPB	A,B
	OUTSTR	[ASCIZ /Please type your Project and Programmer name.
/]
	JRST	LOGIN1
	SUBTTL	CONTINUE. CHECK FOR SPECIALS
LOGPRO:	OUTSTR	[ASCIZ/Login is prohibited
/]
	EXIT

LOGIN2:	MOVE	P,[IOWD	PDLEN,PDLIST]		;MAKE SURE STACK IS HAPPY
NOTGOD:	MOVE	A,USER
	HRRZ	C,USER
IFG PROTLN,<
	MOVSI	B,-PROTLN
	CAME	A,PROTAB(B)
	CAMN	C,PROTAB(B)
	JRST	LOGPRO			;PROHIBIT LOGIN
	AOBJN	B,.-3
>
IFG NNETLN,<
	TRNN	FL,IMPLIN
	JRST	NOTGD1
	MOVSI	B,-NNETLN
	CAME	A,NNETAB(B)
	CAMN	C,NNETAB(B)
	JRST	LOGPRO			;PROHIBIT LOGIN
	AOBJN	B,.-3
>	

NOTGD1:
	TRNE	FL,MAINT+CTYLIN+NOTNOW	;MAINTMODE OR CTY OR REFUSING LOGIN?
	TRNE	FL,PTYLIN		;LET PTY IN SINCE ITS CONTROLLER GOT IN.
	JRST	UFDCHK			;NOT MAINTMODE OR A PTY.
	TRC	FL,MAINT+CTYLIN
	TRCN	FL,MAINT+CTYLIN	
	JRST	UFDCHK			;MAINTMODE & CTY. LET ANYONE IN
	HRRZ	A,USER			;GET NAME OF USER
	MOVSI	B,-GOODTL		;GET LENGTH OF GOODGUY TABLE
	JUMPE	B,NTGD1A
	CAME	A,GOODGY(B)		;IS THIS A GOODGUY
	AOBJN	B,.-1			;NO LOOP
	JUMPL	B,UFDCHK		;JUMP TO LET HIM IN
NTGD1A:	TRNN	FL,MAINT+NOTNOW		;MAINT MODE OR REFUSING LOGINS?
	JRST	NOCTYL			;NO. MUST BE THE CTY
	TRNE	FL,MAINT
	JRST	NOTGD2			;GIVE MAINT. MESSAGE
	OUTSTR	[ASCIZ/The system is not available for normal operation/]
	JRST	NOTGD3
NOTGD2:	OUTSTR	[ASCIZ/The system is down for maintenance/]
NOTGD3:	OUTSTR	[ASCIZ/ at this time.
You can't login unless you know the /]
	MOVE	W,MPASS
	PUSHJ	P,PASSGO
	JRST	.+2
	JRST	UFDCHK
	OUTSTR	[ASCIZ/Sorry. Please try again later.
/]
	EXIT

NOCTYL:	OUTSTR	[ASCIZ/The CTY is for debugging only,
unless you know the /]
	MOVE	W,CPASS
	PUSHJ	P,PASSGO
	EXIT

UFDCHK:
UFDCK1:	MOVE	A,USER		;GET THE PPN
	MOVEM	A,UFDLOK
	MOVSI	B,'UFD'		;LOOK FOR <PPN>.UFD
	SETZ	C,		;
	MOVE	D,GOD		;THIS IS MFD'S PPN
	MOVEM	D,UFDLOK+3
	LOOKUP	DMP,A		;LOOK FOR UFD.
	JRST	SURE		;NO UFD. ASK HIM THE QUESTION.
	MOVEM	B,UFDLOK+1
	MOVEM	C,UFDLOK+2
	JRST	FNDPP		;VALID UFD. WE LET HIM THROUGH

SURE:	CLOSE	DMP,
	HRRZ	B,B		;GET THE ERROR CODE
	JUMPN	B,UFDLER	;JUMPE IF ERROR STATUS FROM LOOKUP
	SKIPE	GOTUFD		;DID WE GO THRU HERE BEFORE
	JRST	NOUFD		;CAN'T FIND IT AGAIN!
	TRNE	FL,PTYLIN	;NO UFD YET. NOT IN LIST. BUG HIM.
	EXIT			;KILL ANY PTY'S
	MOVE	A,USER
	CAMN	A,['100100']	;100,100 WE ALLOW
	JRST	SUR2
IFN NETGUE,<
	CAMN	A,['NETGUE']	;THIS UFD OUGHT NOT DISAPPEAR
	JRST	SUR4
>
SUR1:	ANDI	A,-1		;RIGHT SIDE ONLY
	LSH	A,6		;DISASSEMBLE PRG
	CAMG	A,['9←←←']
	JUMPN	A,SUR1		;NUMBER SEEN. LOOP UNTIL SOMETHING NICE HAPPENS
	JUMPE	A,BADPPN	;JUMP IF NOTHING BUT NUMBERS
SUR2:	TRNN	FL,IMPLIN	;IS THIS AN IMP?
	JRST	SUR3
IFN NETGUE,<
	OUTSTR	[ASCIZ/We prefer that our ARPA NET guests login as "NET,GUE".
Type "Y" to be logged in as "NET,GUE"; anything else to proceed: /]
	PUSHJ	P,YORN
	JRST	SUR2A		;HE DOESN'T WANT TO BE NET,GUE.
	MOVE	D,['NETGUE']	;NOW WE HAVE A NEW NAME.
	MOVEM	D,USER		;SAVE IT
	JRST	LOGIN2		;TRY AGAIN.
>


SUR2A:	OUTSTR	NNUFD
	EXIT
NNUFD:	ASCIZ	/
Sorry.  Since too many network users have abused our hospitality, we
no longer allow the use or creation of a guest account.
You may run certain programs without logging in.  Type: HELP ARPA
/

SUR3:	OUTSTR	[ASCIZ /Are you sure? /]
	PUSHJ	P,YORN
	JRST	LOGIN1		;ANOTHER NON-EX UFD TAKES GAS.
SUR4:
IFE NETGUE,<
	MOVE	A,USER
	CAMN	A,['NETGUE']
	JRST	SUR2A
>
	PUSHJ	P,UCHECK	;CHECK THE EXISTANCE OF A USER.
	MOVE	A,USER		;MAKE A UFD FOR THIS GUY
	MOVSI	B,'UFD'
	MOVSI	C,005000	;SET PROTECTION OF UFD
	MOVE	D,GOD		;NAME OF 1,1
	ENTER	DMP,A		;MAKE UFD BY DOING ENTER
	JRST	UFDEER		;CAN'T MAKE A UFD?
	SETZM	INFOS		;ZERO STUFF
	MOVE	A,[XWD INFOS,INFOS+1]
	BLT	A,INFOS+INFON-1
	MOVSI	A,400000
	SKIPN	CKCODE		;IS THIS GUY AUTHORIZED?
	MOVEM	A,INFOS+LASDAT	;NO! SET BIT IN LASDAT
	MTAPE	DMP,WRINFO	;WRITE INFOS ENTRY TO INITIALIZE
	JFCL
	CLOSE	DMP,		;CLOSE THE FILE (IS EMPTY FILE)
	SETOM	GOTUFD		;SET FLAG ABOUT HAVING MADE A UFD
	JRST	UFDCK1		;BACK AND LOOK FOR THE FILE

FNDPP:	SETOM	GOTUFD
	MTAPE	DMP,RDINFO		;READ INFO ENTRY FROM HIS UFD
	JRST	.+2
	JRST	FNDPP1			;IS OK
	SETZM	INFOS
	SETZM	GOTUFD
	MOVE	A,[XWD INFOS,INFOS+1]
	BLT	A,INFOS+INFON-1
FNDPP1:	SETZM	INFOS+DEFPRO+1
	MOVE	A,NOW
	SKIPGE	INFOS+LASDAT
	TLO	A,400000		;KEEP LOSER BIT SET.
	EXCH	A,INFOS+LASDAT		;SAVE CURRENT TIME
	TLZ	A,400000
	MOVEM	A,LASLOG		;SAVE DATE,TIME OF LAST LOGIN
	SKIPE	W,INFOS+LOSPSW		;DOES THIS GUY HAVE A PASSWORD?
	JRST	LGN3A			;YES ASK FOR IT. 

;IF NETGUE=0 THEN NOONE WITH ACCOUNT NAME NET,GUE CAN GET THIS FAR?
	MOVE	A,USER			;GET USER NAME
	TRNE	FL,IMPLIN		;IMP?
	CAMN	A,['NETGUE']		;YES. OK PPN?
	JRST	LOGIN8			;NOT IMP, OR [NET,GUE]
	MOVE	B,INFOS+DEFPRO		;GET THE DEFAULT PROTECTION WORD
	TLNE	B,400	
	JRST	LOGIN8			;ALLOW REMOTE LOGIN W/O PASSWORD W/O LUPPRV

COMMENT $
	OUTSTR	[ASCIZ/Please type the Remote User's /]
	MOVE	W,REMPAS
	PUSHJ	P,PASSGO
	SKIPA	W,PHRASE	;GET THE WORD HE TYPED
	JRST	LGN3A0		;PASSWORD IS OK
	JUMPN	W,LEXIT		;HE F***ED UP TOO MANY TIMES
	JRST	LOGIN1		;LET HIM TRY ANOTHER NUMBER
LGN3A0:OUTSTR	[ASCIZ/The Remote User's Password has been eliminated.
You must have a password on your PPN to log in remotely.  You can set a password for
remote logins only: log in with % as the delimiter between prj and prg names, and
it will explain how.
/]
	JRST	LOGIN8
$

	OUTSTR	[ASCIZ /Remote login prohibited for that account.
You must log in locally and set a password to allow remote logins.
/]
	JRST	LEXIT
	
LGN3A:	TRNN	FL,IMPLIN		;IF THIS IS A LOCAL USER
	SKIPL	UFDLOK+2		;  AND PASSWORD IS REMOTE-ONLY,
	SKIPA	A,USER
	JRST	LOGIN8			;  DON'T BOTHER ASKING
	TRNN	FL,PTYLIN
	JRST	LOGIN3
	CAMN	A,PTYPPN
	JRST	LOGIN9			;AVOID PASSWORD CHECK FOR PTY IF
					;CONTROLLER HAS SAME PPN.
LOGIN3:	PUSHJ	P,PASSGO
	SKIPA	W,PHRASE	;GET THE WORD HE TYPED
	JRST	LGIN3B		;PASSWORD IS OK
	JUMPN	W,LEXIT		;HE F***ED UP TOO MANY TIMES
	JRST	LOGIN1		;LET HIM TRY ANOTHER NUMBER

HELP1:	OUTSTR	HLP1MS
	JRST	HELP1R

HELP2:	OUTSTR	HLP2MS
	JRST	HELP2R

LGIN3B:
IFG SPYLEN,<
	TRNN	FL,IMPLIN		;ON AN IMP?
	JRST	LGIN3C			;NO.
	MOVSI	B,-SPYLEN
	MOVE	A,USER
	HRRZ	C,USER
	CAME	A,SPYTAB(B)
	CAMN	C,SPYTAB(B)
	SKIPA	C,PTYTJB		;SPY ON THIS USER.  SEND MAIL.
	AOBJN	B,.-3
	JUMPG	B,LGIN3C
	MOVEI	D,SPYNOW		;ADDRESS OF MESSAGE
	MOVEM	A,SPYNAM		;NAME OF USER SENT VIA MAIL TOO.
	SKPSEN	C			;SEND MESSAGE TO LISTENER
	JFCL				;MAILBOX FULL
	JFCL				;OK
					;NON EX JOB NUMBER?
LGIN3C:
>
	TRZ	FL,IMPLIN	;HE HAS SUPPLIED A PASSWORD.  MAKE HIM LOCAL
LOGIN8:	MOVE	TAC,MESDAY	;GET THE P-P DELIMITER
	MOVE	W,USER
	CAME	W,['NETGUE']	;DON'T LET THESE TURKEYS SET A PASSWORD
	CAIE	TAC,"%"		;DO WE HAVE TO CHANGE THE PASSWORD
	JRST	LOGIN9		;NO WE'RE ALL SET
	SKIPE	INFOS+LOSPSW	;ALREADY HAS A PASSWORD?
	OUTSTR	[ASCIZ\<cr> - retain old password,
/<cr> - clear password,
or \]
	OUTSTR	[ASCIZ/New /]
	MOVEI	W,0		;TELL PASSGO TO GET US A NEW PASSWORD
	PUSHJ	P,PASSGO	;LOOK FOR A PASSWORD
	SKIPN	A,PHRASE	;GET THE NEW PPN
	CAIN	K,"/"		;IS ZERO. CLEAR OR LEAVE ALONE?  SKIP IF NOT /
	MOVEM	A,INFOS+LOSPSW	;STUFF THIS IN OUR UPPER
	OUTSTR	[ASCIZ/Old Directory Protection = /]
	LDB	A,[POINT 9,UFDLOK+2,8]
	MOVEM	A,UFDLOK+4		;SAVE OLD PROT.
	PUSHJ	P,OCTOUT
	OUTSTR	CRLF
;MAYBE TAKE THIS OUT EVENTUALLY:
	SKIPE	INFOS+LOSPSW
	OUTSTR	[ASCIZ/If you want your password to be used for remote logins only,
turn on the 400 bit in your directory protection.
/]
HELP1R:	OUTSTR	[ASCIZ/New Protection  (<cr> to keep old value, ? for help) = /]
	PUSHJ	P,OCTIN
	JUMPL	C,HELP1			;TELL HIM WHAT TO DO
	JUMPG	C,.+2			;JUMP IF ARGUMENT GIVEN
	LDB	A,[POINT 9,UFDLOK+2,8]	;NO ARGUMENT. USE OLD PROTECTION VALUE
	DPB	A,[POINT 9,UFDLOK+2,8]	;SAVE NEW PROTECTION
	ANDI	A,777
	XORM	A,UFDLOK+4		;FLAG SET IF PROT CHANGES.

	OUTSTR	[ASCIZ/Old Default File Protection = /]
	LDB	A,[POINT 9,INFOS+DEFPRO,8]
	PUSHJ	P,OCTOUT
	OUTSTR	CRLF
HELP2R:	OUTSTR	[ASCIZ/New Protection  (<cr> to keep old value, ? for help) = /]
	PUSHJ	P,OCTIN
	JUMPL	C,HELP2			;MORE BLURBAGE
	JUMPE	C,.+2
	DPB	A,[POINT 9,INFOS+DEFPRO,8]

LOGIN9:
	TRNE	FL,NODATE+MAINT	;SUPPRESS DATE UPDATE?
	JRST	LOG.11		;YES. OUT QUICK
	MTAPE	DMP,WRINFO	;WRITE THE NEW INFO DATA
	JFCL			;IGNORE ERRORS
	CLOSE	DMP,		;CLOSE CHANNEL
	SKIPN	UFDLOK+4	;UFD PROT CHANGED?
	JRST	LOG.11		;NO.
	MOVE	D,[UFDLOK,,A]	;COPY THE LOOKUP BLOCK
	BLT	D,D
	RENAME	DMP,A		;RENAME TO SET THE NEW PROTECTION
	OUTSTR	[ASCIZ/Rename to change UFD protection failed
/]

LOG.11:	PUSHJ	P,AFOOL		;CHECK OUT APRIL 1
	PUSHJ	P,HALLOW	;HALLOWEEN?
	PUSHJ	P,GLOG		;GO LOGIN!
	PUSHJ	P,SYSTAT	;TELL ABOUT SYSTEM STATUS.
;FALL OFF THE PAGE.
	SUBTTL	HERE IMEDIATELY AFTER LOGIN.
	TRNE	FL,PTYLIN+NODATE
	JRST	FOUND		;QUICK EXIT FOR PTY AND GOD TAB USERS
MESMER:	MOVE	A,JOBFF		;LOAD JOBFF
	MOVE	C,MSGPG3	;LOGGED IN MESSAGE TYPE
	MOVEM	A,DISKBF	;SAVE AS BUFFER SPACE FOR DISK
	MOVE	TAC,MESDAY
	CAIE	TAC,"/"		;SUPPRESS NOTICES?
	SETZM	MESDAY		;NO
	JUMPE	C,.+2
	HRLZS	B,MSGPG4
	PUSHJ	P,IDISK		;INIT CHANNEL FOR OPTION FILE
	MOVEM	A,JOBFF		;SET JOBFF ABOVE THE BUFFERS
	PUSHJ	P,OPTION	;READ THE OPTION FILE
	MOVE	A,LASLOG
	MOVEM	A,INFOS+LASDAT
	PUSHJ	P,ALLMES	;THINK ABOUT ALL THE MESSAGES FROM [2,2]
FOUND:	INSKIP	A		;FLUSH ↑O
	JFCL	
	SKIPE	TYIBUF		;SPECIAL HACK MODE?
	JRST	HACKD		;YES.  TYPE ALL THAT SHIT BACK IN.
FOUND1:	TLNN	FL,LOGRUN!%INIT!COOKEE	;RUNING LOGRUN, COOKEE OR INIT FILE?
	JRST	FOUND2
	TLNN FL,LOGRUN		;SKIP IF LOGRUN , PREFER LOGRUN OVER INIT
	SKIPA A,[TRNSWP]	;GET THE BLOCK FOR INIT
	MOVEI	A,LRB		;GET THE BLOCK FOR LOGRUN
	TLNE FL,COOKEE		;DIRECT FOR HIGH BROW COOKIE OPTION
	MOVEI A,['DSK   '↔'BYE   '↔'DMP   '↔0↔'105SGK'↔0]
	SWAP	A,

FOUND2:	TLNN	FL,PORNO
	JRST	LEXIT
	MOVEI	A,PRB
	SWAP	A,
LEXIT:	SKIPE	124
	EXIT	1,		;IF PRIVILEGED, DON'T REALLY EXIT
	EXIT			;NO LEAVE QUIETLY

HACKD:	MOVEI	0,0
	MOVE	B,[POINT 9,TYIBUF]
HACKD1:	ILDB	A,B
HACKD2:	JUMPE	A,HACKD3	;JUMP IF DONE
	PTWR1S	0		;WRITE CHARACTER TO THIS LINE
	JRST	HACKD3		;NO MORE ROOM. EXIT NOW.  AT LEAST WE TRIED
	JRST	HACKD1		;LOOP.

HACKD3:	EXIT			;HEAVE A SIGH OF RELIEF
	SUBTTL	DO THE LOGIN NOW!
GLOG:	HRRZ	A,USER
	MOVE	A,[XWD -LBLEN,DBLOCK]
	SKIPE	DEBUG
	JRST	GLOG1
	SETZM	GUGGLE		;ZERO ALL THE PASSWORDS
	MOVE	B,[XWD GUGGLE,GUGGLE+1]
	BLT	B,ZATCH		;ZERO ALL THE CRUCIAL STUFF

	TRNE	FL,IMPLIN	;IS THIS AN IMP?
	TDZA	B,B		;YES. NETWORK USER DOESN'T GET LOCAL USER BIT
	MOVSI	B,1		;TURN ON THE NOT NETWORK USER BIT
	IOR	B,INFOS+PRVBIT	;OR IN THE BIT
	MOVEM	B,USRBIT	;SAVE PRIVILEGES
	LOGIN	A,

GLOG1:
IFN NETGUE,<
	MOVE	A,USER		;IF HE IS NET,GUE
	TRNN	FL,IMPLIN
	TRNN	FL,PTYLIN
	CAME	A,['NETGUE']	; LET'S SEE WHO HE REALLY IS
	JRST	GLOG1A		; JUST OUT OF CURIOSITY
	OUTSTR	[ASCIZ /What is your name, please? /]
	HRLZI	A,-NGNMLN	;PREPARE TO READ IN CHARS
	MOVE	B,[POINT 7,NGNMBF]
NGNMLP:	INCHWL	C		;GET A CHAR
	CAIN	C,15
	JRST	NGNMDN		;DONE TYPING
	CAIN	C,12
	JRST	NGNMLF		;YOU WOULDN'T HAVE IMAGINED SOMEBODY'D DO THIS...
	IDPB	C,B
	AOBJN	A,NGNMLP
NGNMFL:	INCHWL	C		;OVERFLOW, FLUSH THE REST
	CAIN	C,12
	JRST	NGNMLF
	CAIE	C,15
	JRST	NGNMFL
NGNMDN:	INCHWL	C		;GET THE LF
NGNMLF:	TRNN	A,-1
	JRST	GLOG1A		;HE TYPED NOTHING, FORGET IT
	MOVEI	C,0		;DEPOSIT A NULL FOR LUCK
	IDPB	C,B
	MOVNI	A,6(A)
	IDIVI	A,5		;WORDS OF TMPCOR NEEDED
	HRLM	A,NGNMUU+1	; (NEGATIVE FOR IOWD)
	MOVE	A,[3,,NGNMUU]	;WRITE FILE
	TMPCOR	A,
	JFCL			;LOST, TOO BAD
>

GLOG1A:	PUSHJ	P,LOGON		;TYPE DATE AND TIME
	SETOM	SFLAG		;NO TIMEOUTS ANY MORE
SS1:
	MOVSI	A,-1		;GET CURRENT LEVEL
	SLEVEL	A,
	HLRZ	A,A
	CAIGE	A,144
	TRNE	FL,PTYLIN
	JRST	NOSL
	JUMPE	A,NOSL
	IDIVI	A,12
	ADDI	B,"0"
	JUMPE	A,TSL1
	ADDI	A,"0"
	TTCALL	1,A
TSL1:	TTCALL	1,B
	OUTSTR	[ASCIZ/% SL
/]
NOSL:	POPJ	P,
	SUBTTL	DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
	
GETP:	SETZB	B,PHRASE	;B = SIXBIT ACC.  PHRASE 1
	SETZB	C,PHRASE+1	;C WILL COUNT PHRASES,, PHRASE 2
	MOVEI	D,40		;WE WILL WAIT 32 SECONDS FOR TYPIN
	SKIPN	SFLAG		;ARE WE DOING SPECIAL INPUT?
	JRST	TYPEIN		;NOPE. TIME THIS GUY
	INCHWL	A		;SPECIAL. WE'LL WAIT FOREVER
	JRST	GETCK		;OK. WE SAW ONE.

TYWAIT:	SOJL	D,LEXIT		;DECREASE COUNT. FLUSH IF HE'S TOO SLOW
	MOVEI	A,1		;SLEEP FOR 1 SECOND
	SLEEP	A,		;WHILE WAITING FOR HIM TO TYPE A LINE
TYPEIN:	INCHSL	A		;INPUT A CHARACTER IF LINE READY AND SKIP
	JRST	TYWAIT		;LINE NOT READY. WAIT FOR IT
	JRST	GETCK

GETCH:	INCHRS	A		;GET ANOTHER, OR SKIP
	POPJ	P,		;NOTHING THERE.  WE MAKE AN ERROR
GETCK:	JUMPE	A,GETCH		;FLUSH NULLS. NO ONE CAN SEND THEM.
	JFCL			;PATCH HERE.
	CAIN	A,12		;LF ENDS EVERYTHING
	JRST	GETHF		;ALL DONE
	CAIN	A,15
	JRST	GETCH		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[    ; JUMPE C,GETCH	;FLUSH BLANKS AND TABS IN FIRST TERM
		JUMPE B,GETCH	;FLUSH LEADING BLANKS AND TABS
		JRST GETHF]	;ASSUME THAT WE'VE SEEN WHOLE TERM
	CAIN	A,175		;IS THIS AN ALTMODE?
	EXIT			;YES. ABORT LOGIN
	CAIN	A,"⊗"		;SPECIAL?
	JRST	SETDDT		;YES GO SET THE DEBUG MODE
	CAIE	A,","		;COMMA DELIMITS PHRASE 1.
	CAIN	A,"/"		;SO DOES SLASH
	JRST	GETHF0		;GO ANNOUNCE THE DELIMITER.
	CAIE	A,"."		;ALLOW THIS AS QUICKIE ALSO -- RPH
	CAIN	A,"|"
	JRST	GETHFA
	CAIN	A,"%"		;SO DOES %
	JRST	GETHF0		;DO THE DELIMITER THING
	CAIL	A,"0"
	CAILE	A,"9"
	JRST	.+2
	JRST	GETCON		;ALLOW DIGITS THROUGH
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2		;NOT LOWER CASE
	TRZ	A,40		;MAKE UPPER CASE
	CAIL	A,"A"
	CAILE	A,"Z"
	JRST	[SETOM PHRASE	;THIS IS A LOSER
		POPJ P,]
GETCON:	SUBI	A,40		;MAKE SIXBIT
	ANDI	A,77		;SCRAPE OFF ANY EXCESS BITS.
	TLNE	B,770000	;DON'T SHIFT TOO FAR
	JRST	GETCH		;TOO FAR.  IGNORE ANYTHING ELSE
	LSH	B,6		;MAKE ROOM.
	IOR	B,A
	JRST	GETCH		;GO GET SOME MORE.

GETHFA:	TRO	FL,NODATE	;TURN ON FLAG
GETHF0:	MOVE	K,A		;SAVE THE DELIMITER HERE.
GETHF:	JUMPE	B,CPOPJ		;NO JUSTIFICATION FOR NOTHING.
	MOVEM	B,PHRASE(C)
	CAIN	A,12
	JRST	CPOPJ1
	SETZB	B,D
	JUMPG	C,SSCAN		;SCAN FOR SERVICE LEVEL
	AOJA	C,GETCH		;INCREMENT TERM COUNTER

SSCAN:	INCHRS	A		;GET A CHARACTER
	POPJ	P,		;NO GOOD
	CAIN	A,12		;LINE FEED?
	JRST	SSCANX		;YES THATS ALL
	CAIN	A,15		;FLUSH CR
	JRST	SSCAN
	CAIE	A,40
	CAIN	A,11
	JRST	SSCAN		;FLUSH BLANK,TAB
	CAIL	A,"0"		;SKIP IF TOO SMALL
	CAILE	A,"9"
	POPJ	P,		; THIS IS A LOSS
	IMULI	D,12		;ACCUMULATE IN D
	ADDI	D,-"0"(A)	;ADD IN DIGIT
	JRST	SSCAN

SSCANX:	MOVEM	D,SLREQ		;SAVE SL REQUEST
	JRST	CPOPJ1		;DO THE SKIP RETURN

YORN:	MOVEI	B,74		;60 SECONDS OF WAITING
	CLRBFI			;FLUSH THE WORLD FIRST
YORN0:	MOVEI	A,1		;SLEEP 1 SECOND
	SKIPN	SFLAG		;CAN'T RUN OUT OF TIME.
	SOJL	B,CPOPJ		;RUN OUT OF TIME
	SLEEP	A,		;SLEEP 1 SECOND
	INCHRS	A		;LOOK FOR A CHARACTER	
	JRST	YORN0		;NOT THERE, WAIT
	CLRBFI
	OUTSTR	CRLF
	CAIE	A,"Y"
	CAIN	A,"y"
	JRST	CPOPJ1		;SKIP RETURN FOR "Y"
	CAIE	A,175		;LOOK FOR  ALTMODE
	POPJ	P,		;IS OK
	EXIT			;KILL THE BASTARD

PASSGO:	INSKIP			;FLUSH ↑O
	JFCL			;....
	MOVEI	X,3		;ALLOW THREE TRYS. W CONTAINS REAL PASSWORD
PASSG1:	OUTSTR	[ASCIZ/Password = /]
	PUSH	P,W
	MOVEI	W,0
	TRON	FL,CTLVF	;TURN ON SILENT FLAG
	CTLV			;TURN OFF DUPLEXING
	TRNE	FL,DPYLIN	;SKIP UNLESS A DPY
	LEYPOS	-1400		;SET DPY LINE OFF THE BOTTOM OF THE PAGE
	PUSHJ	P,GETP		;GET A PASSWORD
	JRST	PGLOSE
	JRST	PGWIN

PGLOSE:	SKIPN	W,(P)		;SKIP IF WE'RE LOOKING FOR AN EXISTING PASSWORD.
	AOSE	PHRASE		;GETTING A NEW PASSWORD.  IS IT LEGAL?
	JRST	PGLUZ		;MUST BE  A BLANK PASSWORD, OR ILLEGAL
	OUTSTR	[ASCIZ/A password may contain only letters and digits.  Try again./]
	MOVEI	Y,PASSGO	;CALL REMAINDER AS A SUBR.
	MOVEM	Y,(P)		;SET "RETURN ADDRESS"
	PUSH	P,W		;AND SET GOAL PASSWORD ON STACK (ZERO)
				;FALL INTO PGLUZ, POP W, POPJ TO PASSGO

PGLUZ:	SETZM	PHRASE		;NOTHING THERE
PGWIN:	CAIE	A,12		;GOBBLE EXTRA CHARS IF ANY
PASG1A:	INCHRS	A
	JRST	PASG1B
	CAIN	A,175
	EXIT			;AS USUAL
	CAIE	A,12
	JRST	PASG1A
PASG1B:	POP	P,W
	TRZE	FL,CTLVF	;TURN OFF FLAG, ECHO ON
	CTLV			;TOGGLE DUPLEXING BACK ON.
	TRNN	FL,DPYLIN
	JRST	PASSG2	
	LEYPOS	0		;RESET LINE EDITOR
	TRNN	FL,PTYLIN!IMPLIN	;SKIP IF THIS IS A PTY OR IMP
	PTWR1W	[0
		10044]		;SEND A CLEAR TO FLUSH HIS LINE EDITOR
PASSG2:	OUTSTR	CRLF		;TYPE CRLF SINCE IT DOESN'T ECHO
	JUMPE	W,CPOPJ		;EMPTY REALLY MEANS GET A NEW ONE
	SKIPN	Y,PHRASE	;IF PHRASE IS EMPTY
	POPJ	P,		;RETURN QUICK
	CAMN	Y,W		;RIGHT PASSWORD?
	JRST	CPOPJ1		;YES
PASSG3:	SOJLE	X,CPOPJ		;COUNT A LOSS AND RETURN IF TOO MANY
	OUTSTR	[ASCIZ/Wrong. Try again.
/]
	JRST	PASSG1		;LOOP

SETDDT:	SKIPN	JOBDDT		;SKIP IF WE HAVE DDT
	POPJ	P,		;ILLEGAL CHARACTER IN SCAN
	CLRBFI			;FLUSH TYPE AHEAD
	OUTSTR	[ASCIZ/Master /]
	MOVE	W,ONEPAS	;THE MAGIC WORD
	PUSHJ	P,PASSGO	;MAKE SURE HE TYPES IT.
	JRST	UEXIT		;HE'S A LOSER
	OUTSTR	[ASCIZ/(DDT)
/]				;TELL HIM WHERE ITS AT.
	JRST	@JOBDDT		;JUMP TO DDT
	SUBTTL	DO ALL THE MESSAGE STUFF FROM [2,2]
ALLMES:	MOVE	A,MSGPPN
	MOVSI	B,'UFD'
	SETZB	C,COOKON		;NO COOKIES YET
	MOVE	D,GOD
	PUSHJ	P,DREAD			;READ   2  2.UFD
	JRST	NOMES			;CANT FIND UFD
	JUMPE	W,NOMES			;UFD EMPTY?
	MOVEM	W,MUDPTR		;SAVE POINTER TO UFD
	MOVE	A,USER
	MOVEM	A,PPNMES
	HRRZM	A,MSGPRG		;PROGRAMMER MESSAGE
	HRRZM	A,MSGPG2		;A.P. NOTICE
	HLLZM	A,MSGPRJ		;PROJECT MESSAGE
	HRLZ	A,USER			;GET THE PROGRAMMER NAME
	JUMPE	A,LEXIT			;CAN'T HAPPEN
	TLNE	A,770000
	JRST	.+3
	LSH	A,6
	JRST	.-3
	MOVEM	A,MSGPG1		;NAME OF PURGE MESSAGE TOO.
	MOVEI A,0			;GET DAYCNT FOR EVENT FILES
	DAYCNT A,
	MOVEM A,EVENTY			;SAVE HERE TEMPORARILY
	IDIVI A,7			;FIND DAY OF WEEK
	MOVE A,EVENTY			;GET DAYCNT BACK
	SETZM EVENTZ			;DON'T DO 3-DAYS-FROM-NOW
	CAIN B,2			;  UNLESS IT'S FRIDAY
	MOVEM A,EVENTZ			;  IN WHICH CASE DO IT
	PUSHJ P,CVBTO6			;CONVERT TO SIXBIT OCTAL
	MOVEM C,EVENTX			;SAVE TODAY'S NAME
	AOS A,EVENTY			;AND DO TOMORROW'S
	PUSHJ P,CVBTO6
	MOVEM C,EVENTY
	SKIPN A,EVENTZ			;IF TODAY ISN'T FRIDAY,
	JRST ALNFRI			;  SKIP THIS
	ADDI A,3			;BUT IF IT IS,
	PUSHJ P,CVBTO6			;  GET MONDAY'S DAYCNT FILE
	MOVEM C,EVENTZ			;  AND PRINT THAT ONE TOO
ALNFRI:	SETOM	LPTBUF			;SET ≠0 TO MAKE PUTCHR WORK RIGHT
	MOVSI	N,-MSGLTL		;GET THE - LENGTH OF MESSAGE TABLE
	JUMPE	N,NOMES			;NO TICKEE NO WASHEE
ALLMS1:	MOVE	A,MSGL1(N)		;GET THE NAME OF A FILE
	HLLZ	B,MSGL2(N)		;GET THE FILE EXTENSION
	MOVE	D,MUDPTR		;GET THE DUMP MODE POINTER
	ADDI	D,1			;MAKE DIRECT POINTER
ALLMS2:	CAME	A,0(D)			;SAME NAME?
	JRST	ALLMS3			;NOPE
	HLLZ	C,1(D)			;GET THE EXTENSION FROM UFD
	CAME	B,C			;SAME?
	JRST	ALLMS3			;NOPE
	HRRZ	C,MSGL2(N)		;GET THE CODE FOR ALGORITHM NUMBER
	CAIL	C,DCIDMX		;LESS THAN MAXIMUM ALGORITHM NUMBER
	JRST	ALLMS4			;NOPE. I DON'T UNDERSTAND.
	HLRZ	C,DECIDE(C)		;GET THE DISPATCH FOR BEFORE MESSAGE
	PUSHJ	P,(C)			;DISPATCH
	JRST	ALLMS4			;DON'T PRINT THIS ONE

REPEAT 0,<
	HRRZ	A,3(D)			;GET THE RETRIEVAL ADDRESS FOR FILE
	MOVEM	A,MTPB			;SAVE ADDRESS
	CAIL	A,7*620*12		;IS ADDRESS REASONABLE?
	JRST	ALLMS4			;THIS ONE HAS BAD RETRIEVAL
	MTAPE	DMP,MTP			;READ THE RETRIEVAL AND FIRST BLOCK
	MOVE	A,0(D)			;FILE NAME
	MOVE	B,1(D)			;EXTENSION
	CAMN	A,FILE0			;CHECK RETRIEVAL INFORMATION
	CAME	B,FILE0+1		;CHECK RETRIEVAL INFORMATION
	JRST	ALLMS4			;CAN'T DO ANYTHING ABOUT THAT
	MOVE	B,MSGPPN
	CAME	B,FILE0+3
	JRST	ALLMS4			;BAD RETRIEVAL
	MOVM	W,FILE0+5		;GET THE FILE LENGTH IN WORDS
	JUMPE	W,BIGFLR		;ZERO LENGTH FILES DONE QUICK
	CAILE	W,FILENG		;IS THE FILE ≤ OUR MAX CAPABILITY?
	JRST	BIGFIL			;NO. WE HAVE A BIG FILE. 
	IMULI	W,5			;CONVERT WORDS TO CHARACTERS
	MOVE	X,[POINT 7,FILE]	;POINTER TO THE FILE
	MOVEM	W,DSKBUF+2		;SAVE CHARACTER COUNT
	MOVEM	X,DSKBUF+1		;SAVE BYTE POINTER
	SETOM	DFAKE			;SET FLAG TO ANNOUNCE FAKERY
	JRST	BIGFL1			;FAKE THEM OUT...
>

BIGFIL:	PUSHJ	P,IDISK			;GET DISK AND BUFFERS FOR INPUT
	MOVE	W,0(D)
	MOVE	X,1(D)
	SETZB	Y,DFAKE			;NOT FAKING READS
	MOVE	Z,MSGPPN
	LOOKUP	DSK,W
	JRST	BIGFLR			;CAN'T HAPPEN
	SKIPN	COOKON			;ARE WE DOING FORTUNE COOKIES?
	JRST	ALLM2A			;NO.
	MOVEI	Y,0			;C O O K I E
	MOVS	W,Z			;UNSWAP WORD COUNT
	MOVN	W,W			;UNNEGATE IT
	TIMER	X,			;GET THE CURRENT TIME
	IDIVI	X,-200(W)		;GET THE FILE SIZE-200
	IMULI	Y,5			;TIME 5 CHARS/WORD
	MOVEM	Y,COOKIE		;SAVE AS THE CHARACTER NUMBER IN THE FILE.
ALLM2A:	MOVEI	M,12			;FAKE RDDSK INTO THINKING IT SAW LF
	SETZM	DFAKE
BIGFL1:	PUSHJ	P,RDDSK			;READ
	JRST	BIGFL2			;ALL DONE
	PUSHJ	P,PUTCHR
	JRST	BIGFL1			;LOOP
BIGFL2:	CLOSE	TTY,
	SETZM	DFAKE			;UNFOOL THE PROGRAM
	SETZM	COOKON			;COOKIES EATEN
BIGFLR:	RELEAS	DSK,
LFRDON:	HRRZ	C,MSGL2(N)		;GET THE CODE FOR APRES MESSAGE
	MOVEI	B,CRLF			;WRITE CRLF TO SEPARATE
	PUSHJ	P,PUTSTR
	CLOSE	TTY,			;FORCE OUTPUT
	HRRZ	C,DECIDE(C)		;GET THE DISPATCH
	PUSHJ	P,(C)			;DO IT
	JRST	ALLMS4			;ALL DONE WITH FILE. DO MORE
ALLMS3:	ADD	D,[XWD UFDN,UFDN]	;DIDDLE D
	JUMPL	D,ALLMS2		;LOOP IF WE HAVE MORE TO LOOK FOR
ALLMS4:	AOBJN	N,ALLMS1		;DONE WITH ONE FILE. DO MORE
	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	CLOSE	TTY,
NOMES:	SETZM	LPTBUF			;RESET THE FAKER
	POPJ	P,
DECIDE:	XWD	DDATE,CPOPJ		;
	XWD	PERMES,PERMED		;
	XWD	DONOTE,NOTEDN
	XWD	DOFORT,CPOPJ		;ANY COOKIES?
	XWD	DOXMES,CPOPJ
	XWD	DOPUR,PERMED		;SAME AS PERSONAL MESSAGE DELETE
	XWD	DONAP,PERMED		;MESSAGE FROM AP
	XWD	DODIGS,CPOPJ		;AP NEWS DIGEST.
	XWD	DOONCE,CPOPJ		;DO ONCE TODAY ONLY
SDEF(DCIDMX,.-DECIDE)

DOXMES:	MOVEI	Y,EXPMOD		;GET ADDRESS OF EXP CELL
	PEEK	Y,
	PEEK	Y,
	JUMPE	Y,CPOPJ			;NO MESSAGE IF CELL NOT SET
	JRST	CPOPJ1			;SEND TEXT

DODIGS:	TRNE	FL,DIGEST
	PUSHJ	P,DDATE1		;SEE IF THE DIGEST IS NEW
	POPJ	P,			;NOT NEW. OR NONE REQUESTED.
	INSKIP
	JFCL
	MOVEI	B,[ASCIZ/There's a new A.P. News Digest./]
	PUSHJ	P,PUTSTR
	JRST	PERMS2

DOONCE:	HLRZ X,NOW			;TODAY'S DATE
	HLRZ Y,INFOS+LASDAT		;LAST LOGIN
	CAMLE X,Y			;SKIP IF ALREADY LOGGED IN TODAY
	JRST CPOPJ1			;FIRST LOGIN TODAY, DO IT
DDATE:	SKIPN	MESDAY			;SKIP IF SLASH SEEN
	JRST	CPOPJ1			;NO. TYPE THE MESSAGE
DDATE1:	LDB	Y,[POINT 12,2(D),35]	;GET DATE OF FILE
	LDB	X,[POINT 3,1(D),20]	;DATE75
	DPB	X,[POINT 3,Y,23]	;DATE75
	LDB	X,[POINT 11,2(D),23]	;GET TIME OF FILE
	HRL	X,Y			;GET DATE,,TIME OF FILE
	CAML	X,INFOS+LASDAT		;SKIP IF PRECEDES LAST LOGIN
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,			;RETURN

DOPUR:	MOVEI	B,[ASCIZ/
The following message is from the purger:

/]
	AOS	(P)
	JRST	PUTSTR

PERMES:	INSKIP				;CLEAR ↑O
	JFCL				;I DON'T CARE ABOUT IT
	MOVEI	B,[ASCIZ/There's a note for /]
	PUSHJ	P,PUTSTR
	MOVE	B,MSGL1(N)		;GET THE NAME OF THE ADDRESSEE
PERMS1:	MOVEI	A,0
	JUMPE	B,PERMS2
	LSHC	A,6
	JUMPE	A,PERMS1		;FLUSH NULLS
	ADDI	A," "
	PUSHJ	P,PUTCHR
	JRST	PERMS1

PERMS2:	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	TRNE	FL,MESSAG		;FORCING MESSAGES?
	JRST	CPOPJ1			;YES.	
	TLNE	FL,NOMAIL
	POPJ	P,			;FLUSH ASKING.
	MOVEI	B,[ASCIZ/Read it now? /]
	TTCALL	11,			;FLUSH TYPE-AHEAD
	PUSHJ	P,PUTSTR		;WRITE A STRING
	CLOSE	TTY,			;FORCE IT OUT
	PUSHJ	P,YORN
	JRST	[CAIE A,"R"
		CAIN A,"r"
		PUSH P,[DONOTE]
		JRST PERMS4]
	AOS	(P)			;SET UP SKIP RETURN
PERMS4:	MOVEI	B,CRLF			;WRITE CRLF AFTER HIS REPLY
	JRST	PUTSTR			;LET PUTSTR RETURN WITH POPJ

PERMED:	SKIPE	NOTEON
	JRST	NOTEDN
	TLNE	FL,NOMAIL
	POPJ	P,
	INSKIP				;TURN OFF ↑O
	JFCL				;IGNORE NON-SKIP
	MOVEI	B,[ASCIZ/
Type "Y" to delete this message now: /]
	PUSHJ	P,PUTSTR		;WRITE STRING
	CLOSE	TTY,			;FORCE IT OUT
	PUSHJ	P,YORN			;ASK
	POPJ	P,			;NO DELETE
	MOVE	W,0(D)
	MOVE	X,1(D)
	SETZ	Y,
	MOVE	Z,MSGPPN
	LOOKUP	DMP,W			;SEEK FILE
	POPJ	P,			;CAN'T FIND IT. THAT'S TOUGH
	SETZB	W,X
	SETZ	Y,
	MOVE	Z,MSGPPN
	RENAME	DMP,W
	JFCL
	CLOSE	DMP,
	POPJ	P,
NOTTY:	OUTSTR	[ASCIZ/TTY INIT FAILED FOR NOTICE TYPEOUT
/]
	EXIT

DONOTE:	SETOM	NOTEON		;DOING NOTICE FILE RIGHT NOW
	JRST	DDATE		;DO THE DATE STUFF
NOTEDN:	SETZM	NOTEON		;CLEAR FLAG
	POPJ	P,		;RETURN

DOFORT:	TRNN	FL,ME
	POPJ	P,		;NO COOKIES!
	SETOM	COOKON		;SET THE COOKIE FLAG
	SETZM	CDONE		;NOT DONE WITH COOKIES YET
	JRST	CPOPJ1		;GOOD COOKIES

DONAP:	MOVEI	B,[ASCIZ/Message from the News Service/]
	PUSHJ	P,PUTSTR
	JRST	PERMS2

CVBTO6:	MOVE D,[POINT 6,C]
	MOVEI C,0
CVB61:	IDIVI A,10
	JUMPE A,CVB62
	HRLM B,(P)
	PUSHJ P,CVB61
	HLRZ B,(P)
CVB62:	ADDI B,'0'
	IDPB B,D
	POPJ P,
	SUBTTL	BUFFERED READER AND OPTION FILE STUFF
rddsk:	sosle	dskbuf+2		;usual disk reader
	jrst	rddsk1			;this guy will strip
	skipe	dfake
	popj	p,			;if faking the disk, don't do input
	movei	a,0
	input	dsk,			;off any line numbers
	statz	dsk,740000		;too!
	jrst	rderr
	statz	dsk,20000
	popj	p,
rddsk1:	ildb	a,dskbuf+1
	push	p,a
	move	a,@dskbuf+1
	trnn	a,1
	jrst	rddsk2			;not part of a sequence number
	aos	dskbuf+1		;sequence number: go past 5 characters
	movni	a,5			;change count
	addm	a,dskbuf+2		;to 5 less
	ADDM	A,COOKIE
	pop	p,(p)
	jrst	rddsk			;read more
rddsk2:	pop	p,a
	SOS	COOKIE
	jumpe	a,rddsk			;ignore nulls
	skipe	cookON
	jrst	rdcook			;read cookie file
	skipn	noteon			;special for notice file?
	jrst	cpopj1
	cain	a,"∂"			;special character?
	jrst	rddsk4			;yes...
rddsk3:	move	m,a			;no. save character
	jrst	cpopj1			;return to caller
rddsk4:	caie	m,12			;last thin seen a line feed?
	jrst	rddsk3			;nope
dtscan:	move	l,d		;save d in l
	pushj	p,digin
	subi	b,1
	movem	b,day		;save day of month
	pushj	p,getsix	;get the name of the month
	hllzm	b,month		;save the month name
	pushj	p,digin		;get the year
	subi	b,100		;subtract 64 from it
	movem	b,year		;save it
	pushj	p,digin		;look for a decimal number
	idivi	b,144
	imuli	b,74
	add	b,c
	movem	b,time		;save time of day
	move	d,l		;restore d from l.
scoop:	pushj	p,rddsk		;scan to the end of the line
	popj	p,		;eof. that's all folks
	caie	a,12
	jrst	scoop		;loop
	SKIPN	mesday		;SKIP if suppressing message
	JRST	RDDSK		;NO SUPRESSING MESSAGES
	move	a,month		;get the month
	movsi	b,-montlg	;- length of month table
	came	a,montht(b)	;same?
	aobjn	b,.-1
	jumpge	b,rddsk		;go write this message
	move	a,year
	imuli	a,14
	addi	a,0(b)
	imuli	a,37
	ADD	A,DAY		;ADD TO GET THE DATE IN SYSTEM FORM
	HRLZ	A,A		;SWAP IT
	HRR	A,TIME		;GET TIME IN MINUTES
	CAMGE	A,INFOS+LASDAT	;SKIP IF MESSAGE RECENT
	POPJ	P,		;NOT RECENT ENOUGH
	JRST	RDDSK		;RECENT MESSAGE. READ AND WRITE

RDERR:	OUTSTR	[ASCIZ/
DATA ERROR IN MESSAGE FILE.
/]
	POPJ	P,


IDISK:	INIT	DSK,200			;INIT THE DISK
	SIXBIT	/DSK/			;SO THAT THE
	XWD	0,DSKBUF		;ROUTINES ON THIS
	JRST	NODISK			;PAGE CAN WORK!
	MOVE	A,DISKBF		;SET UP BUFFERS IN
	EXCH	A,JOBFF			;FIXED CORE
	INBUF	DSK,2			;SO THEY ARE REUSED
	EXCH	A,JOBFF			;SEQUENTIALLY
	SETZM	DFAKE			;DON'T FAKE THE DISK
	POPJ	P,			;RETURN


OPTION:	MOVE	A,[SIXBIT/OPTION/]	;LOOKUP OPTION FILE
	MOVSI	B,'TXT'			;FILE EXTENSION
	SETZ	C,
	MOVE	D,USER
	LOOKUP	DSK,A			;SEEK FILE
	JRST	RPOPJ			;NO OPTIONS. RELEAS DISK AND POPJ
	PUSHJ	P,SEARCH		;LOOK FOR 'LOGIN' IN THE FILE.
	JRST	RPOPJ			;IT'S NOT THERE.
 	CAIE	A,":"			;THIS MUST BE BREAK
	JRST	RPOPJ			;BAD FORMAT FOR FILE
OPT.1:	PUSHJ	P,GETSIX		;GET OPTION NAME
	MOVSI	C,-OPTL			;LOAD TABLE LENGTH
	CAME	B,OPTAB1(C)		;LOOK FOR NAMES MATCH
	AOBJN	C,.-1			;LOOK
	JUMPGE	C,OPT.2			;JUMP IF NOT IN TABLE
	XCT	OPTAB2(C)		;EXECUTE INTRUCTION FROM TABLE
OPT.2:	CAIN	A,","			;LOOK AT BREAK CHARACTER
	JRST	OPT.1			;IS A COMMA. LOOK FOR MORE
RPOPJ:	RELEAS	DSK,
	POPJ	P,

OPTAB1:	'ME    '			;GIVE ME A MESSAGE
	'COOKIE'			;GIVE HIGHER BROW FORTUNE COOKIE MESS
	'MESSAG'			;PERSONAL MSG TYPED AUTOMATICALLY.
	'LOGRUN'			;RUN THE LOGIN POST PROCESS
	'INIT  '			;RUN THE PROGRAM 'INIT' IN USERS AREA
	'WHO   '			;WHO LINE STARTUP
	'UNHIDE'			;UNHIDE THIS DATA DISK.
	'HIDE  '			;NOW THAT THE DEFAULT IS DIFFERENT...
	'FULL  '			;FULL CHARACTER SET
	'TABS  '			;HARDWARE TABS
	'FILL  '			;SET TTYFIL
	'DIGEST'			;GIVE THE AP NEWS DIGEST.
	'PORNO '			;SOFT-CORE
	'NOMAIL'			;SUPPRESS QUESTIONS ABOUT MAIL.
	'AUDIO '			;MUZAK
SDEF(OPTL,.-OPTAB1)			;TABLE LENGTH

OPTAB2:	TRO	FL,ME			;FLAG NAME
	TLO	FL,COOKEE
	TRO	FL,MESSAG	
	TLO	FL,LOGRUN
	TLO FL,%INIT
	PUSHJ	P,[TRNE	FL,DPYLIN	;WHO LINE.  SKIP IF NOT ON A DPY
		TRNE	FL,PTYLIN+IMPLIN	;ON A DPY. SKIP IF NOT PTY
		POPJ	P,			;NOT DPY OR PTY. RETURN
		PTWR1W	[0
			10000+"W"]
		POPJ	P,]			;RETURN TO XCT
	PUSHJ	P,[TRNE FL,DPYLIN		;UNHIDE
		TRNE	FL,PTYLIN+IMPLIN
		POPJ	P,			;NOT ON DPY
		PTWR1W	[0
			14000+"H"]
		POPJ	P,]
	PUSHJ	P,[TRNE FL,DPYLIN		;HIDE
		TRNE	FL,PTYLIN+IMPLIN
		POPJ	P,			;NOT ON DPY
		PTWR1W	[0
			10000+"H"]
		POPJ	P,]
	PUSHJ	P,[TRNE	FL,DPYLIN+PTYLIN	;HERE FOR 'FULL'
		POPJ	P,
		SETO	B,
		TTCALL	6,B
		TLO	B,20			;TURN ON MODEL 37 BITS
		TTCALL	7,B			;SET BITS
		POPJ	P,]
	PUSHJ	P,[TRNE	FL,DPYLIN+PTYLIN	;HERE FOR TABS.
		POPJ	P,
		SETO	B,
		TTCALL	6,B
		TLZ	B,10			;CLEAR TBXPND
		TTCALL	7,B
		POPJ	P,]
	PUSHJ	P,[TRNE	FL,DPYLIN+PTYLIN	;HERE FOR FILL.
		POPJ	P,
		SETO	B,
		TTCALL	6,B
		TLO	B,100000		;SET TTYFIL
		TTCALL	7,B
		POPJ	P,]
	TRO	FL,DIGEST			;SET FLAG FOR THE DIGEST
	TLO	FL,PORNO
	TLO	FL,NOMAIL
	PUSHJ	P,AUDIO			;READ AUDIO CHANNEL # FROM FILE AND SET


SEARCH:	SETZM	DFAKE		;DON'T FAKE THE GUY
	PUSHJ	P,GETSIX	;GET SOME SIXBIT FROM FILE
	CAMN	B,[SIXBIT/LOGIN /]
	JRST	CPOPJ1		;SEARCH WINS.
	JRST	SR.2
SR.1:	PUSHJ	P,RDDSK		;READ DISK
	POPJ	P,		;SEARCH LOSES
SR.2:	CAIE	A,14		;FF OR LF TO END THE LINE.
	CAIN	A,12		;LOOK FOR LINE FEED
	JRST	SEARCH		;GOT A NEW LINE. DO THE THING.
	JRST	SR.1		;LOOP


GETSIX:	SETZ	B,
	MOVEI	C,6
	MOVE	D,[POINT 6,B]
GSIX.1:	PUSHJ	P,RDDSK		;GET SOME
	POPJ	P,		;THAT'S ALL FOLKS
	CAIE	A,40		;SKIP SPACES
	CAIN	A,11		;AND TABS
	JRST	[JUMPE B,GSIX.1	;SKIP LEADING BLANKS, TABS
		POPJ	P,]	;OTHERWISE RETURN
	CAIE	A,"="		;TO PARSE "AUDIO=N"
	CAIN	A,14		;FLUSH FF.
	POPJ	P,
	CAIE	A,12
	CAIN	A,15
	POPJ	P,		;RETURN IF CR OR LF SEEN
	CAIE	A,","		;COMMAS
	CAIN	A,";"		;SEMICOLONS
	POPJ	P,		;BOTH TERMINATE SIXBIT SCAN.
	CAIE	A,"-"		;MINUS SIGN TERMINATES SCAN TOO
	CAIN	A,":"		;: TERMIATES SCAN TOO
	POPJ	P,		;RETURN
	CAIL	A,"A"+" "
	CAILE	A,"Z"+" "
	JRST	.+2
	TRZ	A,40		;MAKE LOWER → UPPER
	SUBI	A,40		;MAKE THINGS INTO SIXBIT
	SOJL	C,GSIX.1	;DECREMENT COUNT. JUMP IF WE HAVE ENOUGH
	IDPB	A,D		;STUFF TEXT IN B
	JRST	GSIX.1		;LOOP

DIGIN:	SETZ	B,		;ACCUMULATE DECIMAL
DIGIN1:	PUSHJ	P,RDDSK		;READ
	POPJ	P,		;EOF. RETURN
	CAIE	A," "
	CAIN	A,11
	JUMPE	B,DIGIN1	;SKIP LEADING BLANKS AND TABS
	CAIL	A,"0"
	CAILE	A,"9"		;MAKE SURE WE HAVE A DIGIT
	POPJ	P,		;NO DIGIT. RETURN
	IMULI	B,12
	ADDI	B,-"0"(A)
	JRST	DIGIN1		;LOOP

RDCOOK:	SKIPL	COOKIE		;TIME FOR COOKIES NOW?
	JRST	RDDSK		;NO. NOT YET.  GO READ MORE CHARACTERS
	SKIPL	COOKON		;HAVE WE FLUSHED PAST FIRST LF YET?
	JRST	RDCK1		;YES. IT IS TIME TO BE PRINTING MESSAGE
	CAIN	A,12		;IS THIS A LF?
	MOVMS	COOKON		;YES. SET COOKON >0 TO MARK TYPING PHASE.
	JRST	RDDSK		;AND READ NEXT CHR.

RDCK1:	SKIPE	CDONE		;DONE WITH COOKIES YET
	POPJ	P,		;YES. RETURN QUICK
	CAIN	A,12		;END OF LINE YET?
	SETOM	CDONE		;YES NOW WE ARE DONE WITH COOKIES.
	JRST	CPOPJ1
	
AUDIO:	CAIE	A,"="		;AUDIO SWITCH OPTION
	POPJ	P,		;MUST BE "AUDIO=N"
	TRNE	FL,DPYLIN	;SKIP IF NOT ON A DPY
	TRNE	FL,PTYLIN+IMPLIN	;ON A DPY. SKIP IF NOT PTY
	JRST	AUDIO4		;NO, SKIP THE NUMBER
	PTWR1W	[0
		10042]		;SEND ESC
AUDIO1:	PUSHJ	P,RDDSK		;LOOP TO SEND DIGITS
	JRST	AUDIO2
	CAIN	A,"-"
	JRST	AUDIO3
	CAIL	A,"0"
	CAILE	A,"7"
	JRST	AUDIO2		;STOP AFTER DIGITS
AUDIO3:	MOVEI	B,(A)
	MOVEI	A,0
	PTWR1W	A		;SEND THE DIGIT
	JRST	AUDIO1
AUDIO2:	PTWR1W	[0
		"U"]		;(A)UDIO
	POPJ	P,		;NEXT BETTER BE COMMA IF THERE ARE MORE OPTS
AUDIO4:	PUSHJ	P,RDDSK
	POPJ	P,
	CAIN	A,"-"
	JRST	GETSIX
	CAIL	A,"0"
	CAILE	A,"7"
	POPJ	P,
	JRST	GETSIX
	SUBTTL	UCHECK	CHECK VALIDITY BEFORE MAKING NEW UFD.
UCHECK:	MOVE	A,['ALFACT']
	MOVSI	B,'DAT'
	SETZ	C,
	MOVE	D,['ACTSYS']
	PUSHJ	P,DREAD
	JRST	UCKER1		;ERROR 1, FILE NOT THERE OR READ ERRORS.
	HRLZ	A,USER		;GET THE PROGRAMMER NAME.
	AOJGE	W,UCKER1	;JUMP IF FILE IS EMPTY.
UCHEK1:	HLLZ	C,(W)		;GET ENTRY FROM FILE
	CAMN	C,A
	POPJ	P,		;IS OK TO GO ON,
	AOBJN	W,UCHEK1	;LOOP LOOKING.
	TDZA	A,A
UCKER1:	MOVEI	A,1
	MOVEM	A,CKCODE	;SAVE THE CKECK CODE.
	MOVEI	W,5
UCKE1A:	SOJL	W,UCKER2
	MOVSI	A,'LOG'
	MOVSI	B,'LOG'
	SETZ	C,
	MOVE	D,['ACTSYS']
	LOOKUP	DMP,A		;GET THE FILE OPEN FOR READING
	JRST	[SETZ	D,
		HRRZ B,B
		JUMPE B,.+1	;RETURN IF STILL OK.
		MOVEI B,1
		SLEEP B,
		JRST UCKE1A]
	MOVS	Y,D
	MOVN	Y,Y
	MOVSI	A,'LOG'
	MOVSI	B,'LOG'
	SETZ	C,
	MOVE	D,['ACTSYS']
	ENTER	DMP,A
	JRST	[MOVEI D,1	;LOOP WAITING
		SLEEP D,
		SOJGE W,UCKE1A	;TRY IT ALL AGAIN
		JRST UCKER2]
	SETZ	Z,
	LSHC	Y,-7
	JUMPE	Z,UCHEK2
	ROT	Z,7		;RESTORE Z TO NORMAL
	USETI	DMP,1(Y)	;REMEMBER THIS IS BAG BITING 1-ORIGIN
	INPUT	DMP,[IOWD 200,BUF
			0]
	STATO	DMP,740000
	STATO	DMP,20000
	JRST	UCKER3
	USETO	DMP,1(Y)	;SET SAME BLOCK FOR OUTPUT (1-ORIGIN)
	JRST	UCHEK3		;AND JUMP

UCHEK2:	UGETF	DMP,Y		;GET THE NEXT FREE BLOCK NUMBER
	USETO	DMP,(Y)		;SET FOR OUTPUT
UCHEK3:	MOVEI	Y,BUF(Z)	;GET THE FIRST FREE WORD OF BUFFER.
	TIMER	A,		;GET THE TIME OF DAY
	IDIVI	A,74*74		;DIVIDE BY 3600, LEAVE MINUTES IN A.
	DATE	B,
	HRRZM	A,(Y)		;SAVE TIME
	HRLM	B,(Y)		;SAVE DATE TOO
	MOVE	A,USER
	MOVEM	A,1(Y)
	MOVSI	A,400000
	SKIPN	CKCODE		;SKIP IF THERE WAS A LOOKUP FAILURE.
	IORM	A,(Y)		;THIS IS A DEFINITE BAD GUY.
	SETO	A,
	TTCALL	6,A
	MOVEM	A,2(Y)		;SAVE LINE CHARACTERISTICS OF USER'S TTY.
	ADDI	Z,3		;WE HAVE ADDED 3 WORDS TO FILE.
	MOVN	Y,Z		;GET THE NEGATIVE
	MOVS	Y,Y
	HRRI	Y,BUF-1
	SETZ	Z,
	OUTPUT	DMP,Y
	CLOSE	DMP,
UCHEK4:	SKIPN	CKCODE
	OUTSTR	[ASCIZ/You are not known as an authorized user.
/]
	POPJ	P,

UCKER2:	OUTSTR	[ASCIZ/UNABLE TO ENTER THE LOGGING FILE.
/]
	CLOSE	DMP,
	JRST	UCHEK4

UCKER3:	OUTSTR	[ASCIZ/DATA ERROR IN THE LOGGING FILE.
/]
	JRST	UCHEK4

	SUBTTL	PREPARE SYSTEM STATISTICS.
SYSTAT:	TRNN	FL,IMPLIN		;NOBODY WANTS THIS. MAKE THE NET TAKE IT
	POPJ	P,			;YES. DON'T TELL HIM.
	MOVEI	A,210
	PEEK	A,			;BASE OF JBTSTS
	HRLI	A,A			;SET FOR INDEXING
	MOVEM	A,JBTSTS		;SAVE IT
	MOVEI	A,231			;PEEK
	PEEK	A,
	HRLI	A,A			;THE BASE OF JOBQUE
	MOVEM	A,JOBQUE		;SAVE IT.
	MOVEI	A,222
	PEEK	A,
	MOVEM	A,JOBN			;SAVE JOBN.
	SETZB	A,C			;FOR ALL JOBS...
SYS.1:	MOVEI	B,@JBTSTS
	PEEK	B,
	TLNN	B,40000			;JNA?
	JRST	SYS.2			;FREE SLOT.
	ADDI	C,1
	MOVEI	B,@JOBQUE
	PEEK	B,
	MOVM	B,B
	CAIN	B,6
	JRST	SYS.1A			;COUNT DIOWQ AS A RUN QUEUE TOO.
	CAIE	B,14
	CAIN	B,15
SYS.1A:	ADDI	C,1000			;COUNT RUNQ+TQ
SYS.2:	CAMGE	A,JOBN
	AOJA	A,SYS.1
	MOVEM	C,SVSTAT
	ANDI	C,777
	MOVE	A,C
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ jobs logged in. /]
	MOVE	A,SVSTAT
	LSH	A,-11
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ Running.
/]
	POPJ	P,
;	A FOOL AND HIS MONEY ARE SOON PARTED
AFOOL:	TRNN	FL,FOOLS	;APRIL 1?
	POPJ	P,
	HRRZ	C,USER		;WHO IS THIS?
	CAIN	C,'GUE'
	JRST	AFOOL1
	HLLZ	C,LASLOG
	HLLZ	B,NOW
	TRNN	FL,PTYLIN
	CAMN	C,B		;SKIP MESSAGE IF HE LOGGED IN ONCE ALREADY TODAY
	POPJ	P,
AFOOL1:	OUTSTR	AFOOM
	MOVEI	C,20
	MOVEI	B,1
AFOOL2:	INCHRS	A
	JRST	.+2
	POPJ	P,
;	SLEEP	B,
;	SOJG	C,AFOOL2
	POPJ	P,


AFOOM:	ASCIZ	%

Important Announcement:

Due to lack of interest April Fools Day has been canceled.

%

comment % 1974

The University administration has decided not to reinstall the
building air-conditioning because of the energy crisis.  They plan to
move the computer to Pine Hall, where the existing a/c will be
adequate.

If the appeal to the Provost fails, we will start the move on May 1.
The computer will be unavailable during the two months it takes to move.

Project personnel will not be moved; a microwave link will permit the
Data Disk and III displays to be used here.

The PDP-6 won't be moved because of its relative inutility.  PDP-6
users should reprogram on the PDP-11.

%
;ALL HALLOWS EVE
HALLOW:	TRNE	FL,PTYLIN		;FOR PTYS (NOT ARPA) WE DO NOTHING
	POPJ	P,			;SKIP IF WE'RE NOT A DISPLAY TERMINAL
	HLRZ	A,NOW			;GET THE DATE
	IDIVI	A,37*14			;YEARS IN A, DAY OF YEAR IN B.
	CAIE	B,37*12-1		;SKIP IF OCT 31
	POPJ	P,
VOD←←1

	MOVEI	W,10			;COUNT TRIES THRU LOOP

VODAGN:	OUTSTR	[ASCIZ/Trick or Treat?/]
	TRNN	FL,DPYLIN
	JRST	VODDON
	INIT	VOD,410			;init voder, don't wait for it
	'VOD   '
	VODBUF,,
	JRST	VODDON			;DONE WITH VODER
	MOVSI	A,001100
	HLLM	A,VODBUF+1
	MOVEI	C,DATA
	PUSHJ	P,VODSTR
	move	a,[325010,,0]
	adsmap	a,
	RELEAS	VOD,
	move	a,[320000,,0]
	adsmap	a,
VODDON:	PUSHJ	P,TRSSGO		;LOOK FOR 'TREAT'
	SOJG	W,VODAGN		;LOOP
	OUTSTR	@VODFOO(w)		;TYPE MESSAGE
	outstr	crlf
	POPJ	P,

VODFOO:	[ASCIZ /There's no hope for you.  Stay away from ladders and black cats./]
	[asciz /Sure took you a long time.  Avoid making decisions today./]
	[asciz /You turkey.  You'll get yours in 4 weeks./]
	[asciz /This doesn't seem to be your day.  I suggest you go home./]
	[asciz /Didn't your mother ever warn you about Halloween?  Why not?/]
	[asciz /Congratulations.  You are already a loser.  Details will follow./]
	[asciz /We had hoped for better things from you.  See that you improve./]
	[asciz /Not too bad.  This may be a good day for you./]
	[asciz /Good. You must have done this before./]


VODSTR:	HRLI	C,441100
VODST1:	ILDB	A,C
	JUMPE	A,CPOPJ
	PUSHJ	P,VODOUT
	JRST	VODST1

ZZZ←←0
CCC←←3
DEFINE SAY (N,I)<
	ZZZ←←ZZZ+<<400+N⊗2+I>⊗<CCC*9>>
	CCC←←CCC-1
IFL CCC,<ZZZ
ZZZ←←0
CCC←←3
>
>

DATA:	SAY 25,0	;T
	SAY 27,0	;R
	SAY 71,0	;I
	SAY 46,0	;K
	SAY 57,0	;O
	SAY 65,1	;R
	SAY 25,1	;T
	SAY 65,1	;R
	SAY 15,1	;E
	SAY 15,1	;E
	SAY 25,1	;T
	SAY 66,1
	ZZZ
	0


VODBUF:	BLOCK	3

VODOUT:	SOSG	VODBUF+2
	OUT	VOD,
	JRST	VODOU1
	OUTSTR	[ASCIZ/OUTPUT ERROR/]
	HALT

VODOU1:	IDPB	A,VODBUF+1
	POPJ	P,

TRSSGO:	INSKIP			;FLUSH ↑O
	JFCL			;....
	PUSHJ	P,GETP		;GET A PASSWORD
	SETZM	PHRASE
	CAIE	A,12		;GOBBLE EXTRA CHARS IF ANY
TRSG1A:	INCHRS	A
	JRST	TRSG1B
	CAIN	A,175
	EXIT			;AS USUAL
	CAIE	A,12
	JRST	TRSG1A
TRSG1B:	SKIPN	Y,PHRASE	;IF PHRASE IS EMPTY
	POPJ	P,		;RETURN QUICK
	CAMN	Y,[' TREAT']
	JRST	CPOPJ1		;YES
	POPJ	P,
;TEXT OF HELP MESSAGES
	XLIST
HLP1MS:	ASCIZ /The protection code is a three-digit octal number.
You are now being asked for the protection code for your file directory;
this code affects file access for all files in the directory.  If you want
to restrict access to most, but not all, of your files you will have a
chance later to set a default protection code which will be used for all
new files created in this directory unless another protection code is
explicitly supplied.  The protection code controls access for three
categories of users: yourself (same PPN), other local users, and guest
users (i.e., remote logins on NET,GUE).  The bits in the file directory
protection code are interpreted as follows (the given meaning applies
if the corresponding bit is on):
400  The password (if any) for this account will only be required for
     remote login, not for login from a local terminal.
200  Presently unused, please leave it off.
100  You may not write files in this directory.  (You don't want this.)
 40  Other local users may not change the protection codes of your files.
 20  Other local users may not read your files, or your directory itself.
 10  Other local users may not write files in this directory.
  4  Guest users may not change the protection codes of your files.
  2  Guest users may not read your files, or your directory itself.
  1  Guest users may not write files in this directory.
Calculate the protection code you want by adding the desired bits.
/

HLP2MS:	ASCIZ /The protection code is a three-digit octal number.
You are now being asked for the default file protection code; this code
will be used for all new files (not overwriting old files) created in
this directory unless another protection code is explicitly supplied.
The protection code controls access for three categories of users:
yourself (same PPN), other local users, and guest users (i.e., remote
logins on NET,GUE).  The bits in each file's individual protection
code are interpreted as follows (the given meaning applies
if the corresponding bit is on):
400  This file will not be saved on backup tapes by the DART program.
200  The COPY program will not allow you to delete this file without
     reconfirming your intention.
100  You may not overwrite this file.
 40  Other local users may not change the protection code of this file.
 20  Other local users may not read this file.
 10  Other local users may not overwrite this file.
  4  Guest users may not change the protection code of this file.
  2  Guest users may not read this file.
  1  Guest users may not overwrite this file.
Calculate the default protection code you want by adding the desired bits.
/
	LIST
	END	BEGIN